home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / cmln0585.arc / BSLP.DOC < prev    next >
Text File  |  1986-02-27  |  67KB  |  2,228 lines
  1.  
  2.                            BSLP BASIC 
  3.  
  4.     INTRODUCTION 
  5.  
  6.          BMLP and BSLP  are  preprocessor  tools for  Microsoft BASIC.
  7.          
  8.          BMLP is a macro language preprocessor. It allows you to write 
  9.          your programs using macros which you define in the program or 
  10.          within macro library text files.  
  11.          
  12.          BSLP  takes  a  source  file  containing  special  structured 
  13.          statements and translates it into a program containing  BASIC 
  14.          statements.  
  15.          
  16.          Using these tools will help you write  more  concise,  better
  17.          structured BASIC programs,  by allowing you to take advantage
  18.          of these features:
  19.          
  20.          - program  with macros  using parameters and subroutines that
  21.            are  maintained in  libraries where they can be accessed by 
  22.            all your programs.  
  23.          
  24.          - write free-form, indented statements without  line  numbers.  
  25.  
  26.          - include statements from many separate files  and  libraries 
  27.            into  a  single  BASIC  program.  (This lets  you write and 
  28.            maintain your programs in small modules.)  
  29.  
  30.          - organize your subroutines into procedures,  each  with  its 
  31.            own descriptive alpha-numeric name.  
  32.  
  33.          - structure  your programming  with multi-line  conditionals,
  34.            loop  and  case   constructs  similar  to  those  found  in 
  35.            programming languages like C and Pascal.  
  36.  
  37.          When using these preprocessors,  please  bear  in  mind  that 
  38.          these versions are written in BASIC and are provided for your 
  39.          use and you are free to modify them in any manner you see fit.  
  40.          
  41.          If you find these tools useful, we have a package called  PPE 
  42.          (Professional Programming Environment) that  includes a super 
  43.          preprocessor   (SLPC)  which  is  written  in  C  for  faster 
  44.          processing  (300-400  lines/min).  It  does  everything  that 
  45.          these  do PLUS a lot more,  like providing a define statement 
  46.          for text substitution and built-in random file handling macro 
  47.          statements.  It comes with a large library of  macros  and  a 
  48.          library manager program.  
  49.          
  50.          If  you have suggestions,  questions,  comments or would like 
  51.          more information about the PPE package, 
  52.          please contact us at:
  53.  
  54.                  Bendorf Associates
  55.                  P.O. Box 5910è                 6006 S. Main
  56.                  Roswell, NM 88201
  57.                  (505) 347-5701
  58.         
  59.          The following is a list  and  brief  abstract of the files on
  60.          this disk:           
  61.  
  62.          Files for BSLP: Basic Structured Language Preprocessor 
  63.  
  64.            BSLP.P . . . . . . . Structured Language Source Text
  65.            BSLP.BAS . . . . . . Microsoft Basic Source Code
  66.            BSLP.DOC . . . . . . Documentation
  67.            BSLP.MSD . . . . . . MS-DOS Compiled Version (.EXE)
  68.            BSLP.CPM . . . . . . CP/M 80 Compiled Version (.COM)
  69.  
  70.          Files for BMLP: Basic Macro Language Preprocessor
  71.  
  72.            BMLP.P . . . . . . . Structured Language Source Text
  73.            BMLP.BAS . . . . . . Microsoft Basic Source Code
  74.            BMLP.DOC . . . . . . Documentation
  75.            BMLP.MSD . . . . . . MS-DOS Compiled Version (.EXE)
  76.            BMLP.CPM . . . . . . CP/M 80 Compiled Version (.COM)
  77.  
  78.          Files for BSLP & BMLP example programs
  79.  
  80.            XFRAME.M . . . . . . Example Program Source Text
  81.            XFRAME.ML  . . . . . Library for XFRAME.M
  82.            BINPUT.M . . . . . . Example Program Source Text
  83.            BINPUT.ML  . . . . . Library for BINPUT.M
  84.  
  85.  
  86. BSLP.BAS
  87.  
  88. 100 DATA   proc...
  89. 101 DATA   prog...
  90. 102 DATA   when...
  91. 103 DATA   unless.
  92. 104 DATA   repeat.
  93. 105 DATA   loop...
  94. 106 DATA   switch.
  95. 107 DATA   case...
  96. 108 DATA   else...
  97. 109 DATA   break..
  98. 110 DATA   endp...
  99. 111 DATA   pend...
  100. 112 DATA   endw...
  101. 113 DATA   endu...
  102. 114 DATA   until..
  103. 115 DATA   endl...
  104. 116 DATA   endc...
  105. 117 PROC.%   = 1
  106. 118 PROG.%   = 2
  107. 119 WHEN.%   = 3
  108. 120 UNLESS.% = 4
  109. 121 REPEAT.% = 5è122 LOOP.%   = 6
  110. 123 SWITCH.% = 7
  111. 124 CASE.%   = 8
  112. 125 ELSE.%   = 9
  113. 126 BREAK.%  = 10
  114. 127 ENDP.%   = 11
  115. 128 PEND.%   = 12
  116. 129 ENDW.%   = 13
  117. 130 ENDU.%   = 14
  118. 131 UNTIL.%  = 15
  119. 132 ENDL.%   = 16
  120. 133 ENDC.%   = 17
  121. 134 DATA 11,12,13,14,15,16,17,17,13,17
  122. 135 DOT$     = "."
  123. 136 DOTS$    = "...."
  124. 137 SKIP$    = " "
  125. 138 SKIP1$   = "  '"
  126. 139 OEXT$    = ".BAS"
  127. 140 IEXT$    = ".P"
  128. 141 EEXT$    = ".E"
  129. 142 INCL$    = ".INC"
  130. 143 TM$      = " ,="
  131. 144 T.FILE$  = "BSLP.$$$"
  132. 145 T.FILE%  = 1
  133. 146 E.FILE%  = 2
  134. 147 I.FILE%  = 3
  135. 148 O.FILE%  = 3
  136. 149 ERRORS%  = 0
  137. 150 KERR%    = 1
  138. 151 LEVELS%  = 0
  139. 152 PUSH%    = 0
  140. 153 NUM%     = 0
  141. 154 STACK.%  = 0
  142. 155 NKEY%    = 17
  143. 156 INCS%    = 1
  144. 157 INC%     = 0
  145. 158 FILE%    = 2
  146. 159 BASIC$   = "restore.resume.return.goto.gosub"
  147. 160 DIM CLOSING%(10)        ' For error messages.
  148. 161 DIM INC$(50)            ' Include file stack.
  149. 162 DIM STACK$(500)
  150. 163 DIM STACK%(500)
  151. 164 DIM NUM.%(500)
  152. 165 DIM KEYWORD.%(99,2)
  153. 166 DIM XN.%(99)
  154. 167 DIM LOOPS%(99)
  155. 168 DIM SWITCH$(10)         ' For the left operand of SWITCH.
  156. 169 DIM KEYWORD$(22)        ' For error messages.
  157. 170 FOR I%=1 TO NKEY%:READ BUF$:TABLE$=TABLE$+BUF$:KEYWORD$(I%)=BUF$:NEXT I%
  158. 171 FOR I%=1 TO 10:READ CLOSING%(I%):NEXT I%
  159. 172 PRINT "BSLP   V1.1B (C) BENDORF ASSOCIATES, 1984-85"
  160. 173 PRINT:GoSub 566
  161. 174 IF NOT(GOOD%) GOTO 177
  162. 175 GoSub 181
  163. 176 GOTO 179è177 IF NOT(I.FILE$<>"") GOTO 179
  164. 178 PRINT"CANNOT OPEN ";I.FILE$
  165. 179 END
  166. 180     'BEGIN
  167. 181 GoSub 194
  168. 182 CLOSE
  169. 183 IF NOT(ERRORS%=0) GOTO 186
  170. 184 KILL E.FILE$:GoSub 463:CLOSE:KILL T.FILE$
  171. 185 GOTO 188
  172. 186 KILL T.FILE$:PRINT E.FILE$;" PRODUCED WITH ";STR$(ERRORS%);" ERROR(S)."
  173. 187 END
  174. 188 IF NOT(ERRORS%>0) GOTO 191
  175. 189 KILL O.FILE$:PRINT O.FILE$;" ABORTED WITH ";STR$(ERRORS%);" ERROR(S)."
  176. 190 GOTO 192
  177. 191 PRINT"<";O.FILE$;"> DONE!"
  178. 192 RETURN
  179. 193     'PASS_1
  180. 194 Open"O",T.FILE%,T.FILE$:Open"O",E.FILE%,E.FILE$:GoSub 290:INC$(INCS%)=I.FILE$
  181. 195 INC%=INC%+1:FILE%=FILE%+1:FILE$=INC$(INC%):Open"I",FILE%,FILE$
  182. 196 GoSub 201:GoSub 275
  183. 197 IF NOT(FILE%=2) GOTO 196
  184. 198 IF NOT(INC%=INCS%) GOTO 195
  185. 199 RETURN
  186. 200     'INPUT-SOURCE
  187. 201 LINE INPUT #FILE%,BUF$
  188. 202 IF NOT(LEN(BUF$)>2) GOTO 226
  189. 203 XLINE$=BUF$:GoSub 232
  190. 204 IF(LEN(BUF$)=0) GOTO 225
  191. 205 INDEX%=0:GoSub 550
  192. 206 IF NOT(RIGHT$(TEXT$,1)=":") GOTO 210
  193. 207 IF(LEN(SBUFF$)>0)THEN GoSub 266
  194. 208 FLAG%=2:LEVEL$=LEFT$(TEXT$,LEN(TEXT$)-1):COMMENT$=SKIP1$+LEVEL$:GoSub 435
  195. 209 GOTO 225
  196. 210 L$=LEFT$(TEXT$,1):KEYWORD%=0
  197. 211 IF(LEN(TEXT$)<4 OR LEN(TEXT$)>6) GOTO 213
  198. 212 C.$=TEXT$:GoSub 606:KEYS$=C.$+DOTS$:KEYWORD%=INSTR(1,TABLE$,LEFT$(KEYS$,7)):KEYWORD%=(KEYWORD%+6)\7
  199. 213 IF NOT(KEYWORD%>0) GOTO 217
  200. 214 IF(LEN(SBUFF$)>0)THEN GoSub 266
  201. 215 GoSub 269
  202. 216 GOTO 225
  203. 217 IF NOT(L$="-") GOTO 220
  204. 218 GoSub 588
  205. 219 GOTO 225
  206. 220 IF NOT(L$="+") GOTO 224
  207. 221 IF(LEN(SBUFF$)>0)THEN GoSub 266
  208. 222 GoSub 581
  209. 223 GOTO 225
  210. 224 GoSub 251
  211. 225 NERR%=NERR%+1:PRINT #E.FILE%,STR$(NERR%);SKIP$;XLINE$
  212. 226 IF NOT(EOF(FILE%)) GOTO 201
  213. 227 CLOSE #FILE%:FILE%=FILE%-1
  214. 228 IF(SBUFF$="") GOTO 230
  215. 229 BUF$="":CFLAG%=0:GoSub 251
  216. 230 RETURN
  217. 231     'STRIPè232 Z1%=INSTR(BUF$,CHR$(9)):Z2%=INSTR(BUF$,CHR$(10))
  218. 233 WHILE (Z1% OR Z2%)
  219. 234 IF Z1% THEN MID$(BUF$,Z1%,1)=" "
  220. 235 IF Z2% THEN MID$(BUF$,Z2%,1)=" "
  221. 236 Z1%=INSTR(BUF$,CHR$(9)):Z2%=INSTR(BUF$,CHR$(10)):WEND
  222. 237 Z1%=1:WHILE (MID$(BUF$,Z1%,1)=" " AND Z1%<LEN(BUF$)):Z1%=Z1%+1:WEND
  223. 238 Z2%=LEN(BUF$):WHILE (MID$(BUF$,Z2%,1)=" " AND Z2%>1):Z2%=Z2%-1:WEND
  224. 239 IF NOT(Z2%<Z1%) GOTO 242
  225. 240 BUF$=""
  226. 241 GOTO 245
  227. 242 BUF$=MID$(BUF$,Z1%,Z2%-Z1%+1)
  228. 243 IF NOT(LEN(BUF$)>0) GOTO 245
  229. 244 IF(LEFT$(BUF$,1)="'" OR LEFT$(BUF$,3)="REM" OR BUF$=STRING$(LEN(BUF$),32))THEN BUF$=""
  230. 245 LN.%=LEN(BUF$):CFLAG%=0
  231. 246 IF(LN.%=0) GOTO 249
  232. 247 CFLAG%=(RIGHT$(BUF$,1)="|")
  233. 248 IF(CFLAG%)THEN BUF$=LEFT$(BUF$,LN.%-1):LN.%=LEN(BUF$)
  234. 249 RETURN
  235. 250     'OUT_PUT
  236. 251 IF NOT(CFLAG%=0) GOTO 259
  237. 252 IF NOT(LEN(SBUFF$)>0) GOTO 257
  238. 253 IF NOT(LEN(SBUFF$+BUF$)<=250) GOTO 256
  239. 254 BUF$=SBUFF$+BUF$:SBUFF$=""
  240. 255 GOTO 257
  241. 256 GoSub 266
  242. 257 PBUF$=BUF$:FLAG%=3:GoSub 435
  243. 258 GOTO 263
  244. 259 IF NOT(LEN(SBUFF$+BUF$)<=250) GOTO 262
  245. 260 SBUFF$=SBUFF$+BUF$+":"
  246. 261 GOTO 263
  247. 262 GoSub 266:PBUF$=BUF$:GoSub 435
  248. 263 BUF$=""
  249. 264 RETURN
  250. 265     'DUMP
  251. 266 PBUF$=LEFT$(SBUFF$,LEN(SBUFF$)-1):FLAG%=3:GoSub 435:SBUFF$="":CFLAG%=0
  252. 267 RETURN
  253. 268     'KEYWORDS
  254. 269 KERR%=NERR%+1
  255. 270 ON KEYWORD% GOTO 302,319,328,354,364,364
  256. 271 ON KEYWORD%-6 GOTO 405,411,331,421,309,322,343
  257. 272 ON KEYWORD%-13 GOTO 357,371,381,428
  258. 273 RETURN
  259. 274     'POP_ERRORS
  260. 275 KER%=KERR%:KWDS%=KEYWORD%:GoSub 293
  261. 276 while KEYWORD%>0
  262. 277 GoSub 282
  263. 278 wend
  264. 279 GoSub 290:KEYWORD%=KWDS%:KERR%=KER%
  265. 280 RETURN
  266. 281     'RESOLVE-ERRORS
  267. 282 IF(KEYWORD%<11)THEN KEYWORD%=CLOSING%(KEYWORD%)
  268. 283 EBUF$=KEYWORD$(KEYWORD%):GoSub 603
  269. 284 IF NOT(KEYWORD%=ENDW.% OR KEYWORD%=ENDU.% OR KEYWORD%=ENDC.%) GOTO 287
  270. 285 IF(KEYWORD%=ENDC.%)THEN GoSub 293
  271. 286 GoSub 293è287 GoSub 293
  272. 288 RETURN
  273. 289     'PUSH
  274. 290 PUSH%=PUSH%+1:KEYWORD.%(PUSH%,0)=KEYWORD%:KEYWORD.%(PUSH%,1)=KERR%:KEYWORD.%(PUSH%,2)=LEVEL%
  275. 291 RETURN
  276. 292     'POP
  277. 293 IF NOT(PUSH%>0) GOTO 296
  278. 294 KEYWORD%=KEYWORD.%(PUSH%,0):KERR%=KEYWORD.%(PUSH%,1):LEVEL%=KEYWORD.%(PUSH%,2):PUSH%=PUSH%-1
  279. 295 GOTO 297
  280. 296 LEVEL%=-1:KEYWORD%=-1
  281. 297 RETURN
  282. 298     'LEVEL
  283. 299 LEVELS%=LEVELS%+1:LEVEL%=LEVELS%:TK%=LEVEL%:GoSub 290
  284. 300 RETURN
  285. 301     '_PROC
  286. 302 GoSub 275:GoSub 290:GoSub 550
  287. 303 IF NOT(LEN(TEXT$)>0) GOTO 306
  288. 304 COMMENT$=SKIP1$+TEXT$:LPROC$=TEXT$:FLAG%=2:LEVEL$=TEXT$:GoSub 435
  289. 305 GOTO 307
  290. 306 EBUF$="procedure name":GoSub 603
  291. 307 RETURN
  292. 308     '_ENDP
  293. 309 GoSub 293
  294. 310 WHILE KEYWORD%<>PROC.% AND KEYWORD%>0
  295. 311 GoSub 282
  296. 312 WEND
  297. 313 IF NOT(KEYWORD%=PROC.%) GOTO 316
  298. 314 FLAG%=3:PBUF$="RETURN":GoSub 435
  299. 315 GOTO 317
  300. 316 EBUF$=KEYWORD$(PROC.%):GoSub 603
  301. 317 RETURN
  302. 318     '_PROG
  303. 319 PROG..%=1
  304. 320 RETURN
  305. 321     '_PEND
  306. 322 IF NOT(PROG..%=1) GOTO 325
  307. 323 FLAG%=3:PBUF$="END":GoSub 435
  308. 324 GOTO 326
  309. 325 EBUF$=KEYWORD$(PROG.%):GoSub 603
  310. 326 RETURN
  311. 327     '_WHEN
  312. 328 GoSub 299:GoSub 299:FLAG%=1:GoSub 435
  313. 329 RETURN
  314. 330     '_ELSE
  315. 331 GoSub 293
  316. 332 IF NOT(KEYWORD%=WHEN.%) GOTO 340
  317. 333 F.%=LEVEL%:GoSub 293:T.%=LEVEL%:TK%=T.%:FLAG%=4:PBUF$="GOTO ":GoSub 435:XN%=XN%+1:XN.%(XN%)=F.%:GoSub 550:C.$=TEXT$:GoSub 606
  318. 334 IF NOT(C.$="when" OR C.$="unless") GOTO 337
  319. 335 GoSub 299:F.%=LEVEL%:FLAG%=ABS(C.$="when"):GoSub 435:GoSub 293
  320. 336 GOTO 338
  321. 337 F.%=0
  322. 338 KEYWORD%=WHEN.%:LEVEL%=T.%:GoSub 290:LEVEL%=F.%:GoSub 290
  323. 339 GOTO 341
  324. 340 GoSub 290:EBUF$=KEYWORD$(WHEN.%):GoSub 603
  325. 341 RETURNè342     '_ENDW
  326. 343 GoSub 293
  327. 344 IF NOT(KEYWORD%=WHEN.%) GOTO 347
  328. 345 F.%=LEVEL%:GoSub 293:T.%=LEVEL%:GoSub 350
  329. 346 GOTO 348
  330. 347 GoSub 290:EBUF$=KEYWORD$(WHEN.%):GoSub 603
  331. 348 RETURN
  332. 349     'POPOFF
  333. 350 IF(F.%>0)THEN XN%=XN%+1:XN.%(XN%)=F.%
  334. 351 IF(T.%>0)THEN XN%=XN%+1:XN.%(XN%)=T.%
  335. 352 RETURN
  336. 353     '_UNLESS
  337. 354 GoSub 299:GoSub 299:FLAG%=0:GoSub 435
  338. 355 RETURN
  339. 356     '_ENDU
  340. 357 GoSub 293
  341. 358 IF NOT(KEYWORD%=UNLESS.%) GOTO 361
  342. 359 F.%=LEVEL%:GoSub 293:T.%=LEVEL%:GoSub 350
  343. 360 GOTO 362
  344. 361 GoSub 290:EBUF$=KEYWORD$(UNLESS.%):GoSub 603
  345. 362 RETURN
  346. 363     '_REPEAT
  347. 364 GoSub 550:C.$=TEXT$:GoSub 606:LOOP%=LOOP%+1:GoSub 299:XN%=XN%+1:XN.%(XN%)=LEVEL%
  348. 365 IF NOT(C.$<>"when" AND C.$<>"unless") GOTO 368
  349. 366 LOOPS%(LOOP%)=LEVEL%
  350. 367 GOTO 369
  351. 368 LOOPS%(LOOP%)=LEVEL%*-1:GoSub 293:LEVEL%=LEVEL%*-1:GoSub 290:GoSub 299:FLAG%=ABS(C.$="when"):GoSub 435
  352. 369 RETURN
  353. 370     '_UNTIL
  354. 371 IF NOT(LOOP%>0) GOTO 378
  355. 372 GoSub 293
  356. 373 IF NOT(KEYWORD%=REPEAT.% OR KEYWORD%=LOOP.%) GOTO 376
  357. 374 LOOP%=LOOP%-1:TK%=LOOPS%(LOOP%+1):FLAG%=1:GoSub 435
  358. 375 GOTO 377
  359. 376 GoSub 290:EBUF$=KEYWORD$(REPEAT.%):GoSub 603
  360. 377 GOTO 379
  361. 378 EBUF$=KEYWORD$(REPEAT.%):GoSub 603
  362. 379 RETURN
  363. 380     '_ENDL
  364. 381 IF NOT(LOOP%>0) GOTO 402
  365. 382 GoSub 293
  366. 383 IF NOT(KEYWORD%=REPEAT.% OR KEYWORD%=LOOP.%) GOTO 400
  367. 384 GoSub 550:C.$=TEXT$:GoSub 606:LOOP%=LOOP%-1
  368. 385 IF NOT(LOOPS%(LOOP%+1)>0) GOTO 392
  369. 386 TK%=LOOPS%(LOOP%+1)
  370. 387 IF NOT(C.$="when" OR C.$="unless") GOTO 390
  371. 388 FLAG%=ABS(C.$="when"):GoSub 435
  372. 389 GOTO 391
  373. 390 EBUF$=KEYWORD$(WHEN.%):GoSub 603
  374. 391 GOTO 399
  375. 392 TK%=LOOPS%(LOOP%+1)*-1
  376. 393 IF NOT(C.$="when" OR C.$="unless") GOTO 396
  377. 394 FLAG%=ABS(C.$="when")
  378. 395 GOTO 397
  379. 396 FLAG%=4:PBUF$="GOTO "è397 GoSub 435
  380. 398 F.%=LEVEL%:GoSub 293:T.%=LEVEL%:GoSub 350
  381. 399 GOTO 401
  382. 400 GoSub 290:EBUF$=KEYWORD$(LOOP.%):GoSub 603
  383. 401 GOTO 403
  384. 402 EBUF$=KEYWORD$(LOOP.%):GoSub 603
  385. 403 RETURN
  386. 404     '_SWITCH
  387. 405 IF NOT(C.LN.%>0) GOTO 408
  388. 406 GoSub 299:GoSub 299:GoSub 299:SWITCH$(SWITCH%+1)=COND$:SWITCH%=SWITCH%+1
  389. 407 GOTO 409
  390. 408 EBUF$="operand":GoSub 603
  391. 409 RETURN
  392. 410     '_CASE
  393. 411 GoSub 293
  394. 412 IF NOT(KEYWORD%=SWITCH.% AND SWITCH%>0) GOTO 418
  395. 413 IF NOT(C.LN.%>0) GOTO 416
  396. 414 XN%=XN%+1:XN.%(XN%)=LEVEL%:GoSub 299:FLAG%=4:PBUF$="IF("+SWITCH$(SWITCH%)+"<>"+COND$+") GOTO ":GoSub 435
  397. 415 GOTO 417
  398. 416 EBUF$="operand":GoSub 603
  399. 417 GOTO 419
  400. 418 GoSub 290:EBUF$=KEYWORD$(SWITCH.%):GoSub 603
  401. 419 RETURN
  402. 420     '_BREAK
  403. 421 GoSub 293
  404. 422 IF NOT(KEYWORD%=SWITCH.%) GOTO 425
  405. 423 F.%=LEVEL%:GoSub 293:T.%=LEVEL%:TK%=T.%:FLAG%=4:PBUF$="GOTO ":GoSub 435:KEYWORD%=SWITCH.%:LEVEL%=T.%:GoSub 290:LEVEL%=F.%:GoSub 290
  406. 424 GOTO 426
  407. 425 GoSub 290:EBUF$=KEYWORD$(SWITCH.%):GoSub 603
  408. 426 RETURN
  409. 427     '_ENDC
  410. 428 GoSub 293
  411. 429 IF NOT(KEYWORD%=SWITCH.%) GOTO 432
  412. 430 F.%=LEVEL%:GoSub 293:T.%=LEVEL%:GoSub 293:GoSub 350:SWITCH%=SWITCH%-1
  413. 431 GOTO 433
  414. 432 GoSub 290:EBUF$=KEYWORD$(SWITCH.%):GoSub 603
  415. 433 RETURN
  416. 434     'OUT_LINE
  417. 435 IF NOT(FLAG%<2 AND C.LN.%=0) GOTO 438
  418. 436 EBUF$="condition":GoSub 603
  419. 437 GOTO 453
  420. 438 NUM%=NUM%+1:OFFSET%=1
  421. 439 IF(FLAG%<2 OR FLAG%>3)THEN LEVEL$=STR$(TK%):MID$(LEVEL$,1,1)="@"
  422. 440 IF(FLAG%<>0) GOTO 443
  423. 441 PBUF$="IF("+COND$+") GOTO "+LEVEL$
  424. 442 GOTO 451
  425. 443 IF(FLAG%<>1) GOTO 446
  426. 444 PBUF$="IF NOT("+COND$+") GOTO "+LEVEL$
  427. 445 GOTO 451
  428. 446 IF(FLAG%<>2) GOTO 449
  429. 447 GoSub 459
  430. 448 GOTO 451
  431. 449 IF(FLAG%<>4) GOTO 451
  432. 450 PBUF$=PBUF$+LEVEL$
  433. 451 PRINT #T.FILE%,RIGHT$(STR$(NUM%),LEN(STR$(NUM%))-1);SKIP$;PBUF$;COMMENT$è452 IF(XN%>0 AND FLAG%<>2)THEN GoSub 456
  434. 453 COMMENT$="":PBUF$="":LEVEL$=""
  435. 454 RETURN
  436. 455     'STORE_IT
  437. 456 OFFSET%=0:FOR I%=1 TO XN%:LEVEL$=STR$(XN.%(I%)):MID$(LEVEL$,1,1)="@":GoSub 459:NEXT I%:XN%=0
  438. 457 RETURN
  439. 458     'STACK_IT
  440. 459 STACK.%=STACK.%+1:STACK%(STACK.%)=NUM%+OFFSET%:STACK$(STACK.%)=LEVEL$:IF(COMPIL%)THEN NUM.%(STACK.%)=NUM%+OFFSET%
  441. 460 OFFSET%=0
  442. 461 RETURN
  443. 462     'PASS_2
  444. 463 GoSub 534:OFFSET%=2:Open"I",T.FILE%,T.FILE$:Open"O",O.FILE%,O.FILE$
  445. 464 LINE INPUT #T.FILE%,BUF$:GoSub 468
  446. 465 IF NOT(EOF(T.FILE%)) GOTO 464
  447. 466 RETURN
  448. 467     'PROCESS_1
  449. 468 INDEX%=0:ONFLAG%=0:LN.%=LEN(BUF$):GoSub 550:IF(COMPIL%)THEN GoSub 477
  450. 469 while FIRST%<=LEN(BUF$)
  451. 470 IF(LEN(TEXT$)>7 OR LEN(TEXT$)<2 OR VAL(TEXT$)>0) GOTO 472
  452. 471 GoSub 491
  453. 472 GoSub 550
  454. 473 wend
  455. 474 PRINT #O.FILE%,BUF$
  456. 475 RETURN
  457. 476     'COMPIL
  458. 477 TEXT%=VAL(TEXT$):HIGH%=STACK.%+1:LOW%=0
  459. 478 IF(TEXT%<NUM.%(1) OR TEXT%>NUM.%(STACK.%)) GOTO 488
  460. 479 while((HIGH%-LOW%)>1):I%=(HIGH%+LOW%)\2
  461. 480 IF NOT(NUM.%(I%)=TEXT%) GOTO 483
  462. 481 TEXT%=-1:LOW%=HIGH%
  463. 482 GOTO 487
  464. 483 IF NOT(NUM.%(I%)<TEXT%) GOTO 486
  465. 484 LOW%=I%
  466. 485 GOTO 487
  467. 486 HIGH%=I%
  468. 487 wend
  469. 488 IF(TEXT%>0)THEN BUF$=SPACE$(LEN(TEXT$)+1)+COND$
  470. 489 RETURN
  471. 490     'FIND_IT
  472. 491 C.$=TEXT$:GoSub 606
  473. 492 IF NOT(C.$="on") GOTO 495
  474. 493 ONFLAG%=-1
  475. 494 GOTO 502
  476. 495 IF NOT(LEN(C.$)>3) GOTO 502
  477. 496 IF(INSTR(BASIC$,C.$)=0 OR COLN%) GOTO 502
  478. 497 GoSub 550:I$=LEFT$(TEXT$,1)
  479. 498 IF(I$="@" OR LEN(TEXT$)<>4) GOTO 500
  480. 499 C.$=TEXT$:GoSub 606:IF(C.$="else")THEN RETURN
  481. 500 IF(I$="0" AND ONFLAG%) GOTO 502
  482. 501 IF(ONFLAG%)THEN GoSub 504 ELSE GoSub 512
  483. 502 RETURN
  484. 503     'ON_FLAG
  485. 504 OFFSET%=1
  486. 505 while(FIRST%<=LEN(BUF$))
  487. 506 IF(TEXT$<>"")THEN GoSub 512è507 GoSub 550
  488. 508 wend
  489. 509 OFFSET%=2
  490. 510 RETURN
  491. 511     'SEARCH
  492. 512 HIGH%=STACK.%+1:LOW%=0:FIND%=-1
  493. 513 while((HIGH%-LOW%)>1):I%=(HIGH%+LOW%)\2
  494. 514 IF NOT(STACK$(I%)=TEXT$) GOTO 517
  495. 515 FIND%=STACK%(I%):LOW%=HIGH%
  496. 516 GOTO 521
  497. 517 IF NOT(STACK$(I%)<TEXT$) GOTO 520
  498. 518 LOW%=I%
  499. 519 GOTO 521
  500. 520 HIGH%=I%
  501. 521 wend
  502. 522 IF NOT(FIND%>0) GOTO 525
  503. 523 GoSub 529
  504. 524 GOTO 527
  505. 525 IF NOT(TEXT$<>"") GOTO 527
  506. 526 ERRORS%=ERRORS%+1:PRINT"MISSING LABEL (";TEXT$;")"
  507. 527 RETURN
  508. 528     'STUFF_IT
  509. 529 NUM$=STR$(FIND%):SP$="":L$=LEFT$(BUF$,FIRST%-OFFSET%)
  510. 530 IF(LEFT$(COND$,1)<>" " AND LEFT$(COND$,1)<>":" AND ONFLAG%=0)THEN SP$=" "
  511. 531 BUF$=L$+NUM$+SP$+COND$:INDEX%=LEN(L$)+LEN(NUM$):LN.%=LEN(BUF$)
  512. 532 RETURN
  513. 533     'SORT
  514. 534 PT.%=STACK.%:while (PT.%>0):PT.%=PT.%\2
  515. 535 IF NOT(PT.%>0) GOTO 547
  516. 536 JT.%=1:KT.%=STACK.%-PT.%:while (JT.%<=KT.%):LT.%=JT.%:CT.%=LT.%+PT.%
  517. 537 while (LT.%>0 AND STACK$(LT.%)>=STACK$(CT.%))
  518. 538 SWAP STACK$(LT.%),STACK$(CT.%):SWAP STACK%(LT.%),STACK%(CT.%)
  519. 539 CT.%=LT.%:LT.%=LT.%-PT.%:LT.%=LT.%*(1+(LT.%<0))
  520. 540 wend
  521. 541 IF NOT(COMPIL%) GOTO 546
  522. 542 LT.%=JT.%:CT.%=LT.%+PT.%
  523. 543 while (LT.%>0 AND NUM.%(LT.%)>=NUM.%(CT.%))
  524. 544 SWAP NUM.%(LT.%),NUM.%(CT.%):CT.%=LT.%:LT.%=LT.%-PT.%:LT.%=LT.%*(1+(LT.%<0))
  525. 545 wend
  526. 546 JT.%=JT.%+1:wend
  527. 547 wend
  528. 548 RETURN
  529. 549     'PARSER
  530. 550 C.LN.%=0:I.%=0:COLN%=0:II%=32:TEXT%=0:COND$="":TRM$=TM$+CHR$(58*ABS(INDEX%>0))
  531. 551 while(INSTR(TRM$,CHR$(II%))>0):INDEX%=INDEX%+1:IF(INDEX%<=LEN(BUF$))THEN II%=ASC(MID$(BUF$,INDEX%,1)) ELSE II%=7
  532. 552 wend:FIRST%=INDEX%
  533. 553 while(II%<>32 AND II%<>7)
  534. 554 IF NOT(INSTR(TRM$,CHR$(II%))>0 AND TEXT%=0) GOTO 557
  535. 555 COLN%=(CHR$(II%)=":"):I.%=1:II%=32
  536. 556 GOTO 562
  537. 557 IF NOT(II%=34 OR II%=40 OR II%=41) GOTO 560
  538. 558 IF(II%=34)THEN INDEX%=INSTR(INDEX%+1,BUF$,CHR$(34))
  539. 559 IF(II%=40)THEN TEXT%=TEXT%+1 ELSE IF(II%=41)THEN TEXT%=TEXT%-1
  540. 560 INDEX%=INDEX%+1:IF(INDEX%<=LEN(BUF$))THEN II%=ASC(MID$(BUF$,INDEX%,1)) ELSE II%=7
  541. 561 IF(II%=32 AND TEXT%<>0) GOTO 560è562 wend
  542. 563 TEXT$=MID$(BUF$,FIRST%,INDEX%-FIRST%):IF(LEN(BUF$)>INDEX%)THEN COND$=RIGHT$(BUF$,(LEN(BUF$)-INDEX%)+I.%):C.LN.%=LEN(COND$)
  543. 564 RETURN
  544. 565     'FILENAMES
  545. 566 LINE INPUT"INPUT FILE [.P]:",I.FILE$
  546. 567 IF(I.FILE$="") GOTO 579
  547. 568 COMPIL%=(INSTR(I.FILE$,"/")>0)
  548. 569 IF(COMPIL%)THEN I.FILE$=LEFT$(I.FILE$,LEN(I.FILE$)-1)
  549. 570 IF(INSTR(I.FILE$,DOT$)=0)THEN I.FILE$=I.FILE$+IEXT$
  550. 571 LK.$=I.FILE$:LK.%=I.FILE%:GoSub 614:I.FILE%=LK.%:GOOD%=(I.FILE%<>FALSE%)
  551. 572 IF(GOOD%=FALSE%) GOTO 579
  552. 573 I%=INSTR(1,I.FILE$,DOT$)
  553. 574 IF(I%=0)THEN I%=LEN(I.FILE$)+1
  554. 575 E.FILE$=LEFT$(I.FILE$,I%-1):LINE INPUT"OUTPUT FILE [.BAS]:",O.FILE$
  555. 576 IF(O.FILE$="")THEN O.FILE$=E.FILE$
  556. 577 IF(INSTR(O.FILE$,DOT$)=0)THEN O.FILE$=O.FILE$+OEXT$
  557. 578 IF(INSTR(E.FILE$,DOT$)=0)THEN E.FILE$=E.FILE$+EEXT$
  558. 579 RETURN
  559. 580     'INCLUDES
  560. 581 GoSub 599
  561. 582 IF NOT(FILE.%>0) GOTO 585
  562. 583 Open"I",FILE.%,FILE$:FILE%=FILE.%
  563. 584 GOTO 586
  564. 585 EBUF$="include "+FILE$:GoSub 603
  565. 586 RETURN
  566. 587     'SUBROUTINE
  567. 588 GoSub 599
  568. 589 IF NOT(FILE.%>0) GOTO 596
  569. 590 TEXT%=0
  570. 591 while(TEXT%<INCS%)
  571. 592 TEXT%=TEXT%+1:IF(FILE$=INC$(TEXT%))THEN TEXT%=INCS%+1
  572. 593 wend
  573. 594 IF(TEXT%=INCS%)THEN INCS%=INCS%+1:INC$(INCS%)=FILE$
  574. 595 GOTO 597
  575. 596 EBUF$="include "+FILE$:GoSub 603
  576. 597 RETURN
  577. 598     'FILES
  578. 599 FILE$=RIGHT$(TEXT$,LEN(TEXT$)-1):IF(INSTR(FILE$,DOT$)=0)THEN FILE$=FILE$+INCL$
  579. 600 FILE.%=FILE%+1:LK.$=FILE$:LK.%=FILE.%:GoSub 614:FILE.%=LK.%
  580. 601 RETURN
  581. 602     'ERRORS
  582. 603 ERRORS%=ERRORS%+1:EBUF$="ERR#"+STR$(ERRORS%)+" MISSING ("+EBUF$+") PROC <"+LPROC$+">":EBUF$=EBUF$+" AT"+STR$(KERR%):PRINT EBUF$:PRINT #E.FILE%,EBUF$
  583. 604 RETURN
  584. 605     '_Fold
  585. 606 f.0%=1
  586. 607 while(f.0%<=LEN(C.$))
  587. 608 f.2%=ASC(MID$(C.$,f.0%,1))
  588. 609 f.2%=f.2%+(32*ABS(f.2%>64 AND f.2%<91))
  589. 610 MID$(C.$,f.0%,1)=CHR$(f.2%):f.0%=f.0%+1
  590. 611 wend
  591. 612 RETURN
  592. 613     '_Lookup
  593. 614 OPEN"R",LK.%,LK.$:L.K!=LOF(LK.%):CLOSE LK.%
  594. 615 IF(L.K!<1)THEN LK.%=0:KILL LK.$
  595. 616 RETURNè
  596.  
  597. BSLP.DOC
  598.  
  599.  
  600.  
  601.    BSLP Version 1.0B                                                Page 1.0
  602.  
  603.    Table of Contents
  604.  
  605.         BSLP: Basic Structured Language Preprocessor......... 1.1
  606.               Functions...................................... 1.1
  607.               Invocation..................................... 1.1
  608.               Defaults....................................... 1.1
  609.               Option (/)..................................... 1.1
  610.               Structure Keywords............................. 1.1
  611.                    PROG / PEND............................... 1.2
  612.                    PROC / ENDP............................... 1.2
  613.                    REPEAT / UNTIL............................ 1.3
  614.                    LOOP / ENDL............................... 1.3
  615.                    WHEN / ELSE / ENDW........................ 1.4
  616.                    UNLESS / ENDU............................. 1.4
  617.                    SWITCH / CASE / BREAK / ENDC.............. 1.5
  618.               Error Messages................................. 2.1
  619.                    Structure Related Error Handling.......... 2.1
  620.                    Structure Related Error Messages.......... 2.1
  621.               Included Files (+-)............................ 3.1
  622.  
  623.       Notice:
  624.              Delimiter conventions used in this documentation
  625.              are:
  626.                  <> denotes required information
  627.                  [] denotes optional information
  628.  
  629.  
  630.                                                               
  631.  
  632.  
  633.  
  634.    BSLP Version 1.0B                                                Page 1.1
  635.  
  636.    BSLP - Basic Structured Language Preprocessor
  637.  
  638.  
  639.  
  640.     Function:
  641.  
  642.         BSLP   translates   source  text  written  in  BSLP  structure
  643.         language to standard BASIC code.  BSLP  is  a  BASIC  language
  644.         version  of  the PPE structure translater. It is slow but very
  645.         usable,  and  has  served  well  as  a  tool   for   prototype
  646.         extensions  to the structure language. BSLP is written in BSLP
  647.         structure language and should be a useful learning tool.
  648.  
  649.  
  650.     Invocation:
  651.  
  652.         Entering 'BSLP' at the DOS prompt  will  envoke  the  compiled
  653.         version  (.EXE)  of  BSLP.  The (.BAS) version will have to be
  654.         run using the interpreter by entering  'BASICA  BSLP'  at  the
  655.         DOS  prompt. BSLP will then prompt for the input file name and
  656.         the  output  file  name.  The  default  for  the  input   file
  657.         extension  is  '.P',  and  the  default  for  the  output file
  658.         extension is '.BAS'. The slash (/) following  the  input  file
  659.         name  will cause all non-referenced line numbers to be deleted
  660.         from the output file (.BAS). This allows  a  smaller  compiled
  661.         (.EXE) program.
  662.  
  663.  
  664.     Hints and Restrictions:
  665.  
  666.         Structure  keywords  are  not  case or position sensitive, and
  667.         they must (except for spaces and tabs) be the first  words  on
  668.         a  line.  Do  NOT use comments on the same line with keywords.
  669.         The vertical bar (|) may be use to provide line  continuation.
  670.         Continued  lines  will  be  appended,  separating  them with a
  671.         colon (:).
  672.  
  673.  
  674.     Structure Keywords:
  675.  
  676.         PROG / PEND
  677.  
  678.         PROC <label> / ENDP
  679.  
  680.         REPEAT / UNTIL <condition>
  681.  
  682.         LOOP [<when/unless> <condition>] / ENDL [<when/unless> <condition>]
  683.  
  684.         WHEN <condition> / ELSE [<when/unless> <condition>] / ENDW
  685. è        UNLESS <condition> / ENDU
  686.  
  687.         SWITCH <left operand> / CASE <right operand> / BREAK / ENDC
  688.  
  689.  
  690.  
  691.  
  692.  
  693.    BSLP - Basic Structured Language Preprocessor                    Page 1.1
  694.  
  695.  
  696.  
  697.    BSLP Version 1.0B                                                Page 1.2
  698.  
  699.     Structure Keyword Definitions and Usage:
  700.  
  701.     PROG / PEND
  702.  
  703.         'PROG'  identifies  the  main  controlling  procedure   in   a
  704.         program.  'PEND'  identifies the end of the main procedure and
  705.         causes an "END" BASIC keyword to be generated.
  706.  
  707.     Usage:
  708.  
  709.            PROG Calculate               <----------+
  710.                gosub process_one                   | Main
  711.                gosub process_two                   | Procedure
  712.            PEND                         <----------+
  713.  
  714.  
  715.     PROC <label> / ENDP
  716.  
  717.         'PROC' defines the beginning of a procedure  subroutine  using
  718.         a  label  that  may be referenced by name (e.g. 'GOSUB label')
  719.         from any other procedure in the same  program.  'ENDP'  closes
  720.         the  matching  'PROC'  and  terminates  the  procedure  with a
  721.         "RETURN" BASIC keyword. Procedures can not be nested.
  722.  
  723.     Usage:
  724.  
  725.            PROC Test_Out                <----------+
  726.                when status = test                  | Subroutine
  727.                    gosub test_it                   | Procedure
  728.                endw                                |
  729.            ENDP                         <----------+
  730.  
  731.     *Note:
  732.         A label-name immediately followed by a colon (:) may  be  used
  733.         to identify a label without a procedure statement:
  734.  
  735.            e.g...  ERRORTRAP:
  736.  
  737.  
  738.  
  739.  
  740.  
  741.  
  742.  
  743.  
  744.  
  745.  
  746.  
  747.  
  748. è
  749.  
  750.  
  751.  
  752.  
  753.  
  754.  
  755.  
  756.    Structure Keyword Definitions and Usage                          Page 1.2
  757.  
  758.  
  759.  
  760.    BSLP Version 1.0B                                                Page 1.3
  761.  
  762.     REPEAT / UNTIL <condition>
  763.  
  764.         'REPEAT'  defines the top of a conditional loop structure. The
  765.         matching 'UNTIL' defines the bottom  of  the  loop  where  the
  766.         terminating  condition  is tested. The loop is terminated when
  767.         the condition evaluates true.
  768.  
  769.     Usage:
  770.  
  771.            REPEAT                       <----------+
  772.                index = index + 1                   | Loop
  773.                gosub Index_task                    | Structure
  774.            UNTIL index = task.count     <condition-+
  775.  
  776.  
  777.     LOOP [<when/unless> <condition>] / ENDL [<when/unless> <condition>]
  778.  
  779.         'LOOP' defines the top of a loop structure that will  allow  a
  780.         condition  to  be  tested  at  the  top  and  or at the bottom
  781.         matching 'ENDL'. At  the  top  'WHEN'  evaluates  for  a  true
  782.         condition  to  continue  into the loop structure, and 'UNLESS'
  783.         evaluates for a true condition to branch around the  loop.  At
  784.         the  bottom  'WHEN' evaluates for a true condition to exit the
  785.         loop, and 'UNLESS' evaluates for a true condition to  continue
  786.         the  loop. One condition (top or bottom) is required, but both
  787.         may be use.
  788.  
  789.     Usage:
  790.  
  791.            LOOP                         <----------+
  792.                index = index + 1                   | Loop
  793.                gosub Index_task                    | Structure
  794.            ENDL unless index < task     <condition-+
  795.  
  796.            LOOP when index < task       <condition-+
  797.                index = index + 1                   | Loop
  798.                gosub Index_task                    | Structure
  799.            ENDL                         <----------+
  800.  
  801.            LOOP unless index >= task    <condition-+
  802.                index = index + 1                   | Loop
  803.                gosub Index_task                    | Structure
  804.            ENDL when index >= task      <condition-+
  805.  
  806.  
  807.  
  808.  
  809.  
  810.  
  811. è
  812.  
  813.  
  814.  
  815.  
  816.  
  817.  
  818.  
  819.    Structure Keyword Definitions and Usage                          Page 1.3
  820.  
  821.  
  822.  
  823.    BSLP Version 1.0B                                                Page 1.4
  824.  
  825.     WHEN <condition> / ELSE [<when/unless> <condition>] / ENDW
  826.  
  827.         'WHEN-ELSE-ENDW'  provides  for  multiple   line   conditional
  828.         constructs,  with  no limit on the range or depth of level and
  829.         no limit on the number of 'ELSE' statements used. 'ELSE  WHEN'
  830.         defines  the  "ELSE-IF"  construct,  and 'ELSE UNLESS' defines
  831.         the  "ELSE-IF-NOT"  construct.  'ENDW'  closes  the   matching
  832.         'WHEN' and terminates to the next outer level of processing.
  833.  
  834.     Usage:
  835.  
  836.            WHEN method = manual          IF
  837.                goSub Keyboard                THEN
  838.            ELSE WHEN method = auto       ELSE IF
  839.                goSub Process                 THEN
  840.            ELSE UNLESS method = null     ELSE IF NOT
  841.                goSub Process_End             THEN
  842.            ELSE                          ELSE
  843.                goSub End_Process             THEN
  844.            ENDW
  845.  
  846.  
  847.     UNLESS <condition> / ENDU
  848.  
  849.         'UNLESS'  defines  a  "DO  WHEN NOT TRUE" construct and 'ENDU'
  850.         closes the matching 'UNLESS' and terminates to the next  outer
  851.         level of processing.
  852.  
  853.     Usage:
  854.  
  855.            UNLESS abort = true           IF NOT
  856.                gosub Continue                THEN
  857.            ENDU
  858.  
  859.  
  860.  
  861.  
  862.  
  863.  
  864.  
  865.  
  866.  
  867.  
  868.  
  869.  
  870.  
  871.  
  872.  
  873.  
  874. è
  875.  
  876.  
  877.  
  878.  
  879.  
  880.  
  881.  
  882.    Structure Keyword Definitions and Usage                          Page 1.4
  883.  
  884.  
  885.  
  886.    BSLP Version 1.0B                                                Page 1.5
  887.  
  888.     SWITCH <left operand> / CASE <right operand> / BREAK / ENDC
  889.  
  890.         'SWITCH-CASE-ENDC'   provides   an   "ON   CONDITION  PROCESS"
  891.         construct. 'SWITCH' defines the operand on the  left  side  of
  892.         the  equal  sign  and  'CASE' defines the operand on the right
  893.         side. There is no limit on the  number  of  'CASE'  statements
  894.         within   a  procedure.  When  a  'SWITCH=CASE'  is  true,  the
  895.         instructions following that 'CASE' are processed,  and  unless
  896.         a  'BREAK' statement is used, processing will continue through
  897.         to the next  'CASE'  statement.  The  'BREAK'  statement  will
  898.         cause  a branch to the next 'ENDC' statement. The 'BREAK' will
  899.         be  processed  only  if  a  'SWITCH=CASE'  is  true.  When   a
  900.         'SWITCH=CASE'  evaluates  false, processing is branched to the
  901.         next 'CASE' statement. 'SWITCH' statements can  be  nested  to
  902.         ten  (10)  levels.  'ENDC'  closes  the  matching 'SWITCH' and
  903.         terminates to the next outer level of processing.
  904.  
  905.     Usage:
  906.  
  907.            SWITCH method$(method)
  908.            CASE "+"
  909.                answer = answer + number
  910.                BREAK
  911.            CASE "-"
  912.                answer = answer - number
  913.                BREAK
  914.            CASE "*"
  915.                answer = answer * number
  916.                BREAK
  917.            CASE "/"
  918.                when number <> 0
  919.                    answer = answer / number
  920.                else
  921.                    answer = 0
  922.                endw
  923.            ENDC
  924.  
  925.  
  926.  
  927.  
  928.  
  929.  
  930.  
  931.  
  932.  
  933.  
  934.  
  935.  
  936.  
  937. è
  938.  
  939.  
  940.  
  941.  
  942.  
  943.  
  944.  
  945.    Structure Keyword Definitions and Usage                          Page 1.5
  946.  
  947.  
  948.  
  949.    BSLP Version 1.0B                                                Page 2.1
  950.  
  951.     Structure Related Error Handling:
  952.  
  953.         When   a   structure   error   is    encountered,    a    file
  954.         (<program-name>.E)  is  generated,  showing the exact location
  955.         of the error. All structure errors are resolved at the end  of
  956.         each  procedure,  or 'ENDP'. When there are errors immediately
  957.         following an 'ENDP' statement,  the  procedure  preceding  the
  958.         'ENDP' statement will be the source of the errors.
  959.  
  960.     Structure Related Error Messages:
  961.  
  962.         Structure  related  error messages are displayed with a 'ERR#'
  963.         and the error count. These errors  will  be  recorded  in  the
  964.         error file (<program-name>.E).
  965.  
  966.         Structure  related  error  messages  are self explanatory, the
  967.         following are some typical examples:
  968.  
  969.            ERR#1 MISSING (endl) PROC <BEGIN>
  970.                      (A 'LOOP' structure not closed in procedure BEGIN)
  971.            ERR#1 MISSING (switch) PROC <Select>
  972.                      (A 'CASE' or 'BREAK' or 'ENDC' without an  opening
  973.                       'SWITCH' in procedure Select.)
  974.            ERR#1 MISSING (endc) PROC <>
  975.                      (A 'CASE' structure not closed in main procedure.)
  976.            ERR#1 MISSING (include 'filename')
  977.                      (Unable to find an included file.)
  978.  
  979.  
  980.  
  981.  
  982.  
  983.  
  984.  
  985.  
  986.  
  987.  
  988.  
  989.  
  990.  
  991.  
  992.  
  993.  
  994.  
  995.  
  996.  
  997.  
  998.  
  999.  
  1000. è
  1001.  
  1002.  
  1003.  
  1004.  
  1005.  
  1006.  
  1007.  
  1008.    Errors                                                           Page 2.1
  1009.  
  1010.  
  1011.  
  1012.    BSLP Version 1.0B                                                Page 3.1
  1013.  
  1014.     Included Files:
  1015.  
  1016.         There are two methods  to  include  additional  files  into  a
  1017.         program source file for processing:
  1018.  
  1019.     Immediate:
  1020.                +filename.ext
  1021.  
  1022.         The  leading  plus  (+)  will  cause  a  file  to  be included
  1023.         immediately into the program source file  and  processed.  The
  1024.         same  file  or  any  number  of  files  may  be  included  and
  1025.         processed.
  1026.  
  1027.     Stacked:
  1028.                -filename.ext
  1029.  
  1030.         The leading dash (-) will cause a file name to be  stored  and
  1031.         the  file  will  be  included  only one time at the end of the
  1032.         main  program  source  file.  The  same  file  name   may   be
  1033.         referenced  many  times,  with  the  file  included  into  the
  1034.         program source file only one time and processed. The  internal
  1035.         file name storage will hold up to fifty (50) file names.
  1036.  
  1037.     *Note:
  1038.  
  1039.         Nested  includes  may be processed up to five (5) levels deep.
  1040.         Nesting is limited by the number of files that can be open  at
  1041.         the same time. No line numbered include files allowed.
  1042.  
  1043.  
  1044.  
  1045.     WARNING:
  1046.  
  1047.         A  recursive include will blow the internal stack. No check is
  1048.         made for recursive includes.
  1049.  
  1050.  
  1051.  
  1052.  
  1053.  
  1054.  
  1055.  
  1056.  
  1057.  
  1058.  
  1059.  
  1060.  
  1061.  
  1062.  
  1063. è
  1064.  
  1065.  
  1066.  
  1067.  
  1068.  
  1069.  
  1070.  
  1071.    Including Files                                                  Page 3.1
  1073.  
  1074.  
  1075. BSLP.P
  1076.  
  1077. '------------------------------------------------------
  1078. '-(c) Bendorf Associates, 1984-85                     -
  1079. '------------------------------------------------------
  1080. '- Program:BSLP (BASIC STRUCTURED LANGUAGE PREPROCESSOR)
  1081. '- System :PPE
  1082. '- Module :TOOLS
  1083. '- Task   :COMPILE 'SSS' CODE INTO STANDARD BASIC CODE.
  1084. '- Created:10.1.82
  1085. '- By     :D. L. BENDORF
  1086. '- Version:PUBLIC DOMAIN
  1087. '- Notes  :THIS PROGRAM IS NOT FOR RESALE.
  1088. '- History:
  1089. '-   BSLP  translates  source  text  written in 'SSS' structure language to
  1090. '-   standard BASIC code. BSLP is a  BASIC  language  version  of  the  PPE
  1091. '-   structure  translater. It is slow but very usable, and has served well
  1092. '-   as a tool for prototype extensions to the structure language. BSLP  is
  1093. '-   written  in  BSLP  structure  language and should be a useful learning
  1094. '-   tool.
  1095. '- Invocation:
  1096. '-   Entering 'BSLP' at the DOS prompt will  envoke  the  compiled  version
  1097. '-   (.EXE)  of  BSLP.  The  (.BAS)  version  will have to be run using the
  1098. '-   interpreter by entering 'BASICA BSLP' at the  DOS  prompt.  BSLP  will
  1099. '-   then  prompt  for  the  input  file name and the output file name. The
  1100. '-   default for the input file extension is '.P', and the default for  the
  1101. '-   output  file  is  'input-file.BAS'.  The slash (/) following the input
  1102. '-   file name will cause all non-referenced line  numbers  to  be  deleted
  1103. '-   from  the  output  file  (.BAS). This allows a smaller compiled (.EXE)
  1104. '-   program.
  1105. '- Hints and Restrictions:
  1106. '-   'SSS'  keywords  are  not  case or position sensitive, and  they  must
  1107. '-   (except  for spaces and tabs) be the first words on a line. Do NOT use
  1108. '-   comments on the same line with keywords. The vertical bar (|)  may  be
  1109. '-   use  to  provide  line continuation. Continued lines will be appended,
  1110. '-   separating them with a colon (:).
  1111. '- 'SSS' Keywords:
  1112. '-   PROG / PEND
  1113. '-   PROC <label> / ENDP
  1114. '-   REPEAT / UNTIL <condition>
  1115. '-   LOOP [<when/unless> <condition>] / ENDL [<when/unless> <condition>]
  1116. '-   WHEN <condition> / ELSE [<when/unless> <condition>] / ENDW
  1117. '-   UNLESS <condition> / ENDU
  1118. '-   SWITCH <left operand> / CASE <right operand> / BREAK / ENDC
  1119. '------------------------------------------------------
  1120. '- ** Data Division                                   -
  1121. '------------------------------------------------------
  1122. DATA   proc...
  1123. DATA   prog...
  1124. DATA   when...
  1125. DATA   unless.
  1126. DATA   repeat.èDATA   loop...
  1127. DATA   switch.
  1128. DATA   case...
  1129. DATA   else...
  1130. DATA   break..
  1131. DATA   endp...
  1132. DATA   pend...
  1133. DATA   endw...
  1134. DATA   endu...
  1135. DATA   until..
  1136. DATA   endl...
  1137. DATA   endc...
  1138. PROC.%   = 1
  1139. PROG.%   = 2
  1140. WHEN.%   = 3
  1141. UNLESS.% = 4
  1142. REPEAT.% = 5
  1143. LOOP.%   = 6
  1144. SWITCH.% = 7
  1145. CASE.%   = 8
  1146. ELSE.%   = 9
  1147. BREAK.%  = 10
  1148. ENDP.%   = 11
  1149. PEND.%   = 12
  1150. ENDW.%   = 13
  1151. ENDU.%   = 14
  1152. UNTIL.%  = 15
  1153. ENDL.%   = 16
  1154. ENDC.%   = 17
  1155. DATA 11,12,13,14,15,16,17,17,13,17
  1156. DOT$     = "."
  1157. DOTS$    = "...."
  1158. SKIP$    = " "
  1159. SKIP1$   = "  '"
  1160. OEXT$    = ".BAS"
  1161. IEXT$    = ".P"
  1162. EEXT$    = ".E"
  1163. INCL$    = ".INC"
  1164. TM$      = " ,="
  1165. T.FILE$  = "BSLP.$$$"
  1166. T.FILE%  = 1
  1167. E.FILE%  = 2
  1168. I.FILE%  = 3
  1169. O.FILE%  = 3
  1170. ERRORS%  = 0
  1171. KERR%    = 1
  1172. LEVELS%  = 0
  1173. PUSH%    = 0
  1174. NUM%     = 0
  1175. STACK.%  = 0
  1176. NKEY%    = 17
  1177. INCS%    = 1
  1178. INC%     = 0
  1179. FILE%    = 2
  1180. BASIC$   = "restore.resume.return.goto.gosub"èDIM CLOSING%(10)        ' For error messages.
  1181. DIM INC$(50)            ' Include file stack.
  1182. DIM STACK$(500)
  1183. DIM STACK%(500)
  1184. DIM NUM.%(500)
  1185. DIM KEYWORD.%(99,2)
  1186. DIM XN.%(99)
  1187. DIM LOOPS%(99)
  1188. DIM SWITCH$(10)         ' For the left operand of SWITCH.
  1189. DIM KEYWORD$(22)        ' For error messages.
  1190. FOR I%=1 TO NKEY%|
  1191.     READ BUF$|
  1192.     TABLE$=TABLE$+BUF$|
  1193.     KEYWORD$(I%)=BUF$|
  1194. NEXT I%
  1195. FOR I%=1 TO 10|
  1196.     READ CLOSING%(I%)|
  1197. NEXT I%
  1198. '------------------------------------------------------
  1199. '- ** Procedure Division                              -
  1200. '------------------------------------------------------
  1201. prog BSLP
  1202.     PRINT "BSLP   V1.1B (C) BENDORF ASSOCIATES, 1984-85"
  1203.     PRINT|
  1204.     GoSub FILENAMES
  1205.     when GOOD%
  1206.         GoSub BEGIN
  1207.     else when I.FILE$<>""
  1208.         PRINT"CANNOT OPEN ";I.FILE$
  1209.     endw
  1210. pend
  1211. proc BEGIN
  1212.     GoSub PASS_1
  1213.     '
  1214.     ' Kill the error file if no errors in PASS_1.
  1215.     ' Kill the temp file after PASS_2.
  1216.     ' Kill the output file if errors in PASS_2.
  1217.     '
  1218.     CLOSE
  1219.     when ERRORS%=0
  1220.         KILL E.FILE$|
  1221.         GoSub PASS_2|
  1222.         CLOSE|
  1223.         KILL T.FILE$
  1224.     else
  1225.         KILL T.FILE$|
  1226.         PRINT E.FILE$;" PRODUCED WITH ";STR$(ERRORS%);" ERROR(S)."
  1227.         END
  1228.     endw
  1229.     when ERRORS%>0
  1230.         KILL O.FILE$|
  1231.         PRINT O.FILE$;" ABORTED WITH ";STR$(ERRORS%);" ERROR(S)."
  1232.     else
  1233.         PRINT"<";O.FILE$;"> DONE!"
  1234.     endwèendp
  1235. proc PASS_1
  1236.     '
  1237.     ' This is the first phase of processing.
  1238.     ' All included file will be processed here.
  1239.     ' The error file is written during this pass.
  1240.     '
  1241.     Open"O",T.FILE%,T.FILE$|
  1242.     Open"O",E.FILE%,E.FILE$|
  1243.     GoSub PUSH|
  1244.     INC$(INCS%)=I.FILE$
  1245.     loop
  1246.         INC%=INC%+1|
  1247.         FILE%=FILE%+1|
  1248.         FILE$=INC$(INC%)|
  1249.         Open"I",FILE%,FILE$
  1250.         loop
  1251.             GoSub INPUT-SOURCE|
  1252.             GoSub POP_ERRORS
  1253.         until FILE%=2
  1254.     until INC%=INCS%
  1255. endp
  1256. proc INPUT-SOURCE
  1257.     '
  1258.     ' Read the input file and look for SLP keywords.
  1259.     ' Look for include file operators(+-).
  1260.     ' Write error file just in case there is a PASS_1 error.
  1261.     '
  1262.     loop
  1263.         LINE INPUT #FILE%,BUF$
  1264.         when LEN(BUF$)>2
  1265.             XLINE$=BUF$:GoSub STRIP
  1266.             unless LEN(BUF$)=0
  1267.                 INDEX%=0:GoSub PARSER
  1268.                 when RIGHT$(TEXT$,1)=":"
  1269.                     IF(LEN(SBUFF$)>0)THEN GoSub DUMP
  1270.                     FLAG%=2:LEVEL$=LEFT$(TEXT$,LEN(TEXT$)-1)|
  1271.                     COMMENT$=SKIP1$+LEVEL$|
  1272.                     GoSub OUT_LINE
  1273.                 else
  1274.                     L$=LEFT$(TEXT$,1):KEYWORD%=0
  1275.                     unless LEN(TEXT$)<4 OR LEN(TEXT$)>6
  1276.                         C.$=TEXT$:GoSub _Fold|
  1277.                         KEYS$=C.$+DOTS$|
  1278.                         KEYWORD%=INSTR(1,TABLE$,LEFT$(KEYS$,7))|
  1279.                         KEYWORD%=(KEYWORD%+6)\7
  1280.                     endu
  1281.                     when KEYWORD%>0
  1282.                         IF(LEN(SBUFF$)>0)THEN GoSub DUMP
  1283.                         GoSub KEYWORDS
  1284.                     else when L$="-"
  1285.                         GoSub SUBROUTINE
  1286.                     else when L$="+"
  1287.                         IF(LEN(SBUFF$)>0)THEN GoSub DUMP
  1288.                         GoSub INCLUDESè                    else 
  1289.                         GoSub OUT_PUT
  1290.                     endw
  1291.                 endw
  1292.             endu
  1293.             NERR%=NERR%+1|
  1294.             PRINT #E.FILE%,STR$(NERR%);SKIP$;XLINE$
  1295.         endw
  1296.     until EOF(FILE%)
  1297.     CLOSE #FILE%|
  1298.     FILE%=FILE%-1
  1299.     unless SBUFF$=""
  1300.         BUF$="":CFLAG%=0:GoSub OUT_PUT
  1301.     endu
  1302. endp
  1303. proc STRIP
  1304.     '
  1305.     ' Strip the leading and trailing spaces,tabs and linefeeds off of
  1306.     ' the input buffer.
  1307.     ' Look for the continuation operator.
  1308.     '
  1309.     Z1%=INSTR(BUF$,CHR$(9)):Z2%=INSTR(BUF$,CHR$(10))
  1310.     WHILE (Z1% OR Z2%)
  1311.         IF Z1% THEN MID$(BUF$,Z1%,1)=" "
  1312.         IF Z2% THEN MID$(BUF$,Z2%,1)=" "
  1313.         Z1%=INSTR(BUF$,CHR$(9)):Z2%=INSTR(BUF$,CHR$(10))|
  1314.     WEND
  1315.     Z1%=1|
  1316.     WHILE (MID$(BUF$,Z1%,1)=" " AND Z1%<LEN(BUF$))|
  1317.         Z1%=Z1%+1|
  1318.     WEND
  1319.     Z2%=LEN(BUF$)|
  1320.     WHILE (MID$(BUF$,Z2%,1)=" " AND Z2%>1)|
  1321.         Z2%=Z2%-1|
  1322.     WEND
  1323.     when Z2%<Z1%
  1324.         BUF$=""
  1325.     else
  1326.         BUF$=MID$(BUF$,Z1%,Z2%-Z1%+1)
  1327.         when LEN(BUF$)>0
  1328.             IF(LEFT$(BUF$,1)="'" OR LEFT$(BUF$,3)="REM" OR BUF$=STRING$(LEN(BUF$),32))THEN BUF$=""
  1329.         endw
  1330.     endw
  1331.     LN.%=LEN(BUF$):CFLAG%=0
  1332.     unless LN.%=0
  1333.         CFLAG%=(RIGHT$(BUF$,1)="|")
  1334.         IF(CFLAG%)THEN BUF$=LEFT$(BUF$,LN.%-1):LN.%=LEN(BUF$)
  1335.     endu
  1336. endp
  1337. proc OUT_PUT
  1338.     '
  1339.     ' Process lines not beginning with keywords.
  1340.     ' If CFLAG% flag is set, append input lines together
  1341.     ' and always check the total length first.
  1342.     'è    when CFLAG%=0 
  1343.         when LEN(SBUFF$)>0
  1344.             when LEN(SBUFF$+BUF$)<=250
  1345.                 BUF$=SBUFF$+BUF$:SBUFF$=""
  1346.             else
  1347.                 GoSub DUMP
  1348.             endw
  1349.         endw
  1350.         PBUF$=BUF$:FLAG%=3:GoSub OUT_LINE
  1351.     else when LEN(SBUFF$+BUF$)<=250
  1352.         SBUFF$=SBUFF$+BUF$+":"
  1353.     else
  1354.         GoSub DUMP:PBUF$=BUF$:GoSub OUT_LINE
  1355.     endw
  1356.     BUF$=""
  1357. endp
  1358. proc DUMP
  1359.     PBUF$=LEFT$(SBUFF$,LEN(SBUFF$)-1)|
  1360.     FLAG%=3:GoSub OUT_LINE:SBUFF$="":CFLAG%=0
  1361. endp
  1362. proc KEYWORDS
  1363.     '
  1364.     ' Branch to the right keyword processing.
  1365.     ' This is one of the few acceptable uses of the `GOTO'.
  1366.     '
  1367.     KERR%=NERR%+1
  1368.     ON KEYWORD% GOTO _PROC,_PROG,_WHEN,_UNLESS,_REPEAT,_REPEAT
  1369.     ON KEYWORD%-6 GOTO _SWITCH,_CASE,_ELSE,_BREAK,_ENDP,_PEND,_ENDW
  1370.     ON KEYWORD%-13 GOTO _ENDU,_UNTIL,_ENDL,_ENDC
  1371. endp
  1372. proc POP_ERRORS
  1373.     '
  1374.     ' Resolve all un-closed processes and report errors.
  1375.     '
  1376.     KER%=KERR%:KWDS%=KEYWORD%:GoSub POP
  1377.     while KEYWORD%>0
  1378.         GoSub RESOLVE-ERRORS
  1379.     wend
  1380.     GoSub PUSH:KEYWORD%=KWDS%:KERR%=KER%
  1381. endp
  1382. proc RESOLVE-ERRORS
  1383.     IF(KEYWORD%<11)THEN KEYWORD%=CLOSING%(KEYWORD%)
  1384.     EBUF$=KEYWORD$(KEYWORD%):GoSub ERRORS
  1385.     when KEYWORD%=ENDW.% OR KEYWORD%=ENDU.% OR KEYWORD%=ENDC.%
  1386.         IF(KEYWORD%=ENDC.%)THEN GoSub POP
  1387.         GoSub POP
  1388.     endw
  1389.     GoSub POP
  1390. endp
  1391. proc PUSH
  1392.     PUSH%=PUSH%+1|
  1393.     KEYWORD.%(PUSH%,0)=KEYWORD%|
  1394.     KEYWORD.%(PUSH%,1)=KERR%|
  1395.     KEYWORD.%(PUSH%,2)=LEVEL%
  1396. endpèproc POP
  1397.     when PUSH%>0
  1398.         KEYWORD%=KEYWORD.%(PUSH%,0)|
  1399.         KERR%=KEYWORD.%(PUSH%,1)|
  1400.         LEVEL%=KEYWORD.%(PUSH%,2)|        
  1401.         PUSH%=PUSH%-1
  1402.     else
  1403.         LEVEL%=-1|
  1404.         KEYWORD%=-1
  1405.     endw
  1406. endp
  1407. proc LEVEL
  1408.     LEVELS%=LEVELS%+1:LEVEL%=LEVELS%|
  1409.     TK%=LEVEL%:GoSub PUSH
  1410. endp
  1411. proc _PROC
  1412.     GoSub POP_ERRORS|
  1413.     GoSub PUSH|
  1414.     GoSub PARSER
  1415.     when LEN(TEXT$)>0
  1416.         COMMENT$=SKIP1$+TEXT$:LPROC$=TEXT$|
  1417.         FLAG%=2:LEVEL$=TEXT$:GoSub OUT_LINE
  1418.     else
  1419.         EBUF$="procedure name":GoSub ERRORS
  1420.     endw
  1421. endp
  1422. proc _ENDP
  1423.     GoSub POP
  1424.     WHILE KEYWORD%<>PROC.% AND KEYWORD%>0
  1425.         GoSub RESOLVE-ERRORS
  1426.     WEND        
  1427.     when KEYWORD%=PROC.%
  1428.         FLAG%=3:PBUF$="RETURN":GoSub OUT_LINE
  1429.     else
  1430.         EBUF$=KEYWORD$(PROC.%):GoSub ERRORS
  1431.     endw
  1432. endp
  1433. proc _PROG
  1434.     PROG..%=1
  1435. endp
  1436. proc _PEND
  1437.     when PROG..%=1
  1438.         FLAG%=3:PBUF$="END":GoSub OUT_LINE
  1439.     else
  1440.         EBUF$=KEYWORD$(PROG.%):GoSub ERRORS
  1441.     endw
  1442. endp
  1443. proc _WHEN
  1444.     GoSub LEVEL:GoSub LEVEL|
  1445.     FLAG%=1:GoSub OUT_LINE
  1446. endp
  1447. proc _ELSE
  1448.     GoSub POP
  1449.     when KEYWORD%=WHEN.%
  1450.         F.%=LEVEL%:GoSub POP:T.%=LEVEL%:TK%=T.%|è        FLAG%=4:PBUF$="GOTO ":GoSub OUT_LINE|
  1451.         XN%=XN%+1:XN.%(XN%)=F.%|
  1452.         GoSub PARSER:C.$=TEXT$:GoSub _Fold
  1453.         when C.$="when" OR C.$="unless"
  1454.             GoSub LEVEL:F.%=LEVEL%|
  1455.             FLAG%=ABS(C.$="when"):GoSub OUT_LINE:GoSub POP
  1456.         else
  1457.             F.%=0
  1458.         endw
  1459.         KEYWORD%=WHEN.%|
  1460.         LEVEL%=T.%:GoSub PUSH|
  1461.         LEVEL%=F.%:GoSub PUSH
  1462.     else
  1463.         GoSub PUSH|
  1464.         EBUF$=KEYWORD$(WHEN.%):GoSub ERRORS
  1465.     endw
  1466. endp
  1467. proc _ENDW
  1468.     GoSub POP
  1469.     when KEYWORD%=WHEN.%
  1470.         F.%=LEVEL%:GoSub POP:T.%=LEVEL%:GoSub POPOFF
  1471.     else
  1472.         GoSub PUSH|
  1473.         EBUF$=KEYWORD$(WHEN.%):GoSub ERRORS
  1474.     endw
  1475. endp
  1476. proc POPOFF
  1477.     IF(F.%>0)THEN XN%=XN%+1:XN.%(XN%)=F.%
  1478.     IF(T.%>0)THEN XN%=XN%+1:XN.%(XN%)=T.%
  1479. endp
  1480. proc _UNLESS
  1481.     GoSub LEVEL:GoSub LEVEL|
  1482.     FLAG%=0:GoSub OUT_LINE
  1483. endp
  1484. proc _ENDU
  1485.     GoSub POP
  1486.     when KEYWORD%=UNLESS.%
  1487.         F.%=LEVEL%:GoSub POP:T.%=LEVEL%:GoSub POPOFF
  1488.     else
  1489.         GoSub PUSH|
  1490.         EBUF$=KEYWORD$(UNLESS.%):GoSub ERRORS
  1491.     endw
  1492. endp
  1493. proc _REPEAT
  1494.     GoSub PARSER:C.$=TEXT$:GoSub _Fold|
  1495.     LOOP%=LOOP%+1:GoSub LEVEL|
  1496.     XN%=XN%+1:XN.%(XN%)=LEVEL%
  1497.     when C.$<>"when" AND C.$<>"unless"
  1498.         LOOPS%(LOOP%)=LEVEL%|
  1499.     else
  1500.         LOOPS%(LOOP%)=LEVEL%*-1|
  1501.         GoSub POP:LEVEL%=LEVEL%*-1:GoSub PUSH|
  1502.         GoSub LEVEL|
  1503.         FLAG%=ABS(C.$="when")|
  1504.         GoSub OUT_LINEè    endw
  1505. endp
  1506. proc _UNTIL
  1507.     when LOOP%>0
  1508.         GoSub POP
  1509.         when KEYWORD%=REPEAT.% OR KEYWORD%=LOOP.%
  1510.             LOOP%=LOOP%-1:TK%=LOOPS%(LOOP%+1)|
  1511.             FLAG%=1:GoSub OUT_LINE
  1512.         else
  1513.             GoSub PUSH|
  1514.             EBUF$=KEYWORD$(REPEAT.%):GoSub ERRORS
  1515.         endw
  1516.     else
  1517.         EBUF$=KEYWORD$(REPEAT.%):GoSub ERRORS
  1518.     endw
  1519. endp
  1520. proc _ENDL
  1521.     when LOOP%>0
  1522.         GoSub POP
  1523.         when KEYWORD%=REPEAT.% OR KEYWORD%=LOOP.%
  1524.             GoSub PARSER:C.$=TEXT$:GoSub _Fold|
  1525.             LOOP%=LOOP%-1
  1526.             when LOOPS%(LOOP%+1)>0
  1527.                 TK%=LOOPS%(LOOP%+1)
  1528.                 when C.$="when" OR C.$="unless"
  1529.                     FLAG%=ABS(C.$="when"):GoSub OUT_LINE
  1530.                 else
  1531.                     EBUF$=KEYWORD$(WHEN.%):GoSub ERRORS
  1532.                 endw
  1533.             else
  1534.                 TK%=LOOPS%(LOOP%+1)*-1
  1535.                 when C.$="when" OR C.$="unless"
  1536.                     FLAG%=ABS(C.$="when")
  1537.                 else
  1538.                     FLAG%=4:PBUF$="GOTO "
  1539.                 endw
  1540.                 GoSub OUT_LINE
  1541.                 F.%=LEVEL%:GoSub POP:T.%=LEVEL%:GoSub POPOFF
  1542.             endw
  1543.         else
  1544.             GoSub PUSH|
  1545.             EBUF$=KEYWORD$(LOOP.%):GoSub ERRORS
  1546.         endw
  1547.     else
  1548.         EBUF$=KEYWORD$(LOOP.%):GoSub ERRORS
  1549.     endw
  1550. endp
  1551. proc _SWITCH
  1552.     when C.LN.%>0
  1553.         GoSub LEVEL:GoSub LEVEL:GoSub LEVEL|
  1554.         SWITCH$(SWITCH%+1)=COND$|
  1555.         SWITCH%=SWITCH%+1
  1556.     else
  1557.         EBUF$="operand":GoSub ERRORS
  1558.     endwèendp
  1559. proc _CASE
  1560.     GoSub POP
  1561.     when KEYWORD%=SWITCH.% AND SWITCH%>0
  1562.         when C.LN.%>0
  1563.             XN%=XN%+1:XN.%(XN%)=LEVEL%|
  1564.             GoSub LEVEL:FLAG%=4|
  1565.             PBUF$="IF("+SWITCH$(SWITCH%)+"<>"+COND$+") GOTO "|
  1566.             GoSub OUT_LINE
  1567.         else
  1568.             EBUF$="operand":GoSub ERRORS
  1569.         endw
  1570.     else
  1571.         GoSub PUSH|
  1572.         EBUF$=KEYWORD$(SWITCH.%):GoSub ERRORS
  1573.     endw
  1574. endp
  1575. proc _BREAK
  1576.     GoSub POP
  1577.     when KEYWORD%=SWITCH.%
  1578.         F.%=LEVEL%:GoSub POP:T.%=LEVEL%:TK%=T.%|
  1579.         FLAG%=4:PBUF$="GOTO ":GoSub OUT_LINE|
  1580.         KEYWORD%=SWITCH.%|
  1581.         LEVEL%=T.%:GoSub PUSH|
  1582.         LEVEL%=F.%:GoSub PUSH
  1583.     else
  1584.         GoSub PUSH|
  1585.         EBUF$=KEYWORD$(SWITCH.%):GoSub ERRORS
  1586.     endw
  1587. endp
  1588. proc _ENDC
  1589.     GoSub POP
  1590.     when KEYWORD%=SWITCH.%
  1591.         F.%=LEVEL%:GoSub POP:T.%=LEVEL%:GoSub POP|
  1592.         GoSub POPOFF:SWITCH%=SWITCH%-1
  1593.     else
  1594.         GoSub PUSH|
  1595.         EBUF$=KEYWORD$(SWITCH.%):GoSub ERRORS
  1596.     endw
  1597. endp
  1598. proc OUT_LINE
  1599.     '
  1600.     ' Build and output lines to the temp file.
  1601.     '
  1602.     when FLAG%<2 AND C.LN.%=0
  1603.         EBUF$="condition":GoSub ERRORS
  1604.     else
  1605.         NUM%=NUM%+1:OFFSET%=1
  1606.         IF(FLAG%<2 OR FLAG%>3)THEN LEVEL$=STR$(TK%):MID$(LEVEL$,1,1)="@"
  1607.         switch FLAG%
  1608.         case 0
  1609.             PBUF$="IF("+COND$+") GOTO "+LEVEL$
  1610.         break
  1611.         case 1
  1612.             PBUF$="IF NOT("+COND$+") GOTO "+LEVEL$è        break
  1613.         case 2
  1614.             GoSub STACK_IT
  1615.         break
  1616.         case 4
  1617.             PBUF$=PBUF$+LEVEL$
  1618.         endc
  1619.         PRINT #T.FILE%,RIGHT$(STR$(NUM%),LEN(STR$(NUM%))-1);SKIP$;PBUF$;COMMENT$
  1620.         IF(XN%>0 AND FLAG%<>2)THEN GoSub STORE_IT
  1621.     endw
  1622.     COMMENT$="":PBUF$="":LEVEL$=""
  1623. endp
  1624. proc STORE_IT
  1625.     '
  1626.     ' Pop off the target place savers and make tokens of them.
  1627.     '
  1628.     OFFSET%=0|
  1629.     FOR I%=1 TO XN%|
  1630.         LEVEL$=STR$(XN.%(I%)):MID$(LEVEL$,1,1)="@"|
  1631.         GoSub STACK_IT|
  1632.     NEXT I%|
  1633.     XN%=0
  1634. endp
  1635. proc STACK_IT
  1636.     '
  1637.     ' Store the tokens and labels with their corresponding line numbers.
  1638.     '
  1639.     STACK.%=STACK.%+1|
  1640.     STACK%(STACK.%)=NUM%+OFFSET%|
  1641.     STACK$(STACK.%)=LEVEL$|
  1642.     IF(COMPIL%)THEN NUM.%(STACK.%)=NUM%+OFFSET%
  1643.     OFFSET%=0
  1644. endp
  1645. proc PASS_2
  1646.     '
  1647.     ' This is the second phase of processing.
  1648.     ' First the stack has to be sorted in ascending order,
  1649.     ' so we can use a binary search on it.
  1650.     ' Then we read the temp file and process it a line at
  1651.     ' a time.
  1652.     '
  1653.     GoSub SORT|
  1654.     OFFSET%=2|
  1655.     Open"I",T.FILE%,T.FILE$|
  1656.     Open"O",O.FILE%,O.FILE$
  1657.     loop
  1658.         LINE INPUT #T.FILE%,BUF$|
  1659.         GoSub PROCESS_1
  1660.     until EOF(T.FILE%)
  1661. endp
  1662. proc PROCESS_1
  1663.     '
  1664.     ' Scan the input line a word at a time.
  1665.     ' The first word will be the line number.
  1666.     ' Then write the line to the output file.è    '
  1667.     INDEX%=0:ONFLAG%=0:LN.%=LEN(BUF$)|
  1668.     GoSub PARSER|
  1669.     IF(COMPIL%)THEN GoSub COMPIL
  1670.     while FIRST%<=LEN(BUF$)
  1671.         unless LEN(TEXT$)>7 OR LEN(TEXT$)<2 OR VAL(TEXT$)>0
  1672.             GoSub FIND_IT
  1673.         endu
  1674.         GoSub PARSER
  1675.     wend
  1676.     PRINT #O.FILE%,BUF$
  1677. endp
  1678. proc COMPIL
  1679.     '
  1680.     ' Binary search the number stack to see if the line number is used.
  1681.     '
  1682.     TEXT%=VAL(TEXT$):HIGH%=STACK.%+1:LOW%=0
  1683.     unless TEXT%<NUM.%(1) OR TEXT%>NUM.%(STACK.%)
  1684.         while((HIGH%-LOW%)>1)|
  1685.             I%=(HIGH%+LOW%)\2
  1686.             when NUM.%(I%)=TEXT%
  1687.                 TEXT%=-1:LOW%=HIGH%
  1688.             else when NUM.%(I%)<TEXT%
  1689.                 LOW%=I%
  1690.             else
  1691.                 HIGH%=I%
  1692.             endw
  1693.         wend
  1694.     endu
  1695.     IF(TEXT%>0)THEN BUF$=SPACE$(LEN(TEXT$)+1)+COND$
  1696. endp
  1697. proc FIND_IT
  1698.     '
  1699.     ' Look for BASIC'S keywords and get the token/label to replace
  1700.     ' with the corresponding line number.
  1701.     '
  1702.     C.$=TEXT$:GoSub _Fold
  1703.     when C.$="on"
  1704.         ONFLAG%=-1
  1705.     else when LEN(C.$)>3
  1706.         unless INSTR(BASIC$,C.$)=0 OR COLN%
  1707.             GoSub PARSER:I$=LEFT$(TEXT$,1)
  1708.             unless I$="@" OR LEN(TEXT$)<>4
  1709.                 C.$=TEXT$:GoSub _Fold|
  1710.                 IF(C.$="else")THEN RETURN
  1711.             endu
  1712.             unless I$="0" AND ONFLAG%
  1713.                 IF(ONFLAG%)THEN GoSub ON_FLAG ELSE GoSub SEARCH
  1714.             endu
  1715.         endu
  1716.     endw
  1717. endp
  1718. proc ON_FLAG
  1719.     '
  1720.     ' Resolve the `ON GOTO' or `ON GoSub' statements. è    ' Parse all the way to the end of the input line.
  1721.     '
  1722.     OFFSET%=1
  1723.     while(FIRST%<=LEN(BUF$))
  1724.         IF(TEXT$<>"")THEN GoSub SEARCH
  1725.         GoSub PARSER
  1726.     wend
  1727.     OFFSET%=2    
  1728. endp
  1729. proc SEARCH
  1730.     '
  1731.     ' Binary search the token stack to get the corresponding line number.
  1732.     '
  1733.     HIGH%=STACK.%+1:LOW%=0:FIND%=-1
  1734.     while((HIGH%-LOW%)>1)|
  1735.         I%=(HIGH%+LOW%)\2
  1736.         when STACK$(I%)=TEXT$
  1737.             FIND%=STACK%(I%):LOW%=HIGH%
  1738.         else when STACK$(I%)<TEXT$
  1739.             LOW%=I%
  1740.         else
  1741.             HIGH%=I%
  1742.         endw
  1743.     wend
  1744.     when FIND%>0
  1745.         GoSub STUFF_IT
  1746.     else when TEXT$<>""
  1747.         ERRORS%=ERRORS%+1|
  1748.         PRINT"MISSING LABEL (";TEXT$;")"
  1749.     endw
  1750. endp
  1751. proc STUFF_IT
  1752.     '
  1753.     ' Replace the token/label with the corresponding line number.
  1754.     '
  1755.     NUM$=STR$(FIND%):SP$=""|
  1756.     L$=LEFT$(BUF$,FIRST%-OFFSET%)
  1757.     IF(LEFT$(COND$,1)<>" " AND LEFT$(COND$,1)<>":" AND ONFLAG%=0)THEN SP$=" "
  1758.     BUF$=L$+NUM$+SP$+COND$|
  1759.     INDEX%=LEN(L$)+LEN(NUM$)|
  1760.     LN.%=LEN(BUF$)
  1761. endp
  1762. proc SORT
  1763.     '
  1764.     ' Shell-Metzner in-memory sort of the token/label stack.
  1765.     ' Sort the line number stack if the compile flag is set.
  1766.     '
  1767.     PT.%=STACK.%|
  1768.     while (PT.%>0)|
  1769.         PT.%=PT.%\2
  1770.         when PT.%>0
  1771.             JT.%=1:KT.%=STACK.%-PT.%|
  1772.             while (JT.%<=KT.%)|
  1773.                 LT.%=JT.%:CT.%=LT.%+PT.%
  1774.                 while (LT.%>0 AND STACK$(LT.%)>=STACK$(CT.%))è                    SWAP STACK$(LT.%),STACK$(CT.%)|
  1775.                     SWAP STACK%(LT.%),STACK%(CT.%)
  1776.                     CT.%=LT.%:LT.%=LT.%-PT.%:LT.%=LT.%*(1+(LT.%<0))
  1777.                 wend
  1778.                 when COMPIL%
  1779.                     LT.%=JT.%:CT.%=LT.%+PT.%
  1780.                     while (LT.%>0 AND NUM.%(LT.%)>=NUM.%(CT.%))
  1781.                         SWAP NUM.%(LT.%),NUM.%(CT.%)|
  1782.                         CT.%=LT.%:LT.%=LT.%-PT.%:LT.%=LT.%*(1+(LT.%<0))
  1783.                     wend
  1784.                 endw                        
  1785.                 JT.%=JT.%+1|
  1786.             wend
  1787.         endw
  1788.     wend
  1789. endp
  1790. '------------------------------------------------------
  1791. '- ** Sub-Routine Division                            -
  1792. '------------------------------------------------------
  1793. proc PARSER
  1794.     C.LN.%=0:I.%=0:COLN%=0:II%=32:TEXT%=0:COND$=""|
  1795.     TRM$=TM$+CHR$(58*ABS(INDEX%>0))
  1796.     while(INSTR(TRM$,CHR$(II%))>0)|
  1797.         INDEX%=INDEX%+1|
  1798.         IF(INDEX%<=LEN(BUF$))THEN II%=ASC(MID$(BUF$,INDEX%,1)) ELSE II%=7
  1799.     wend|
  1800.     FIRST%=INDEX%
  1801.     while(II%<>32 AND II%<>7)
  1802.         when INSTR(TRM$,CHR$(II%))>0 AND TEXT%=0
  1803.             COLN%=(CHR$(II%)=":"):I.%=1:II%=32
  1804.         else 
  1805.             when II%=34 OR II%=40 OR II%=41
  1806.                 IF(II%=34)THEN INDEX%=INSTR(INDEX%+1,BUF$,CHR$(34))
  1807.                 IF(II%=40)THEN TEXT%=TEXT%+1 ELSE IF(II%=41)THEN TEXT%=TEXT%-1
  1808.             endw
  1809.             loop 
  1810.                 INDEX%=INDEX%+1|
  1811.                 IF(INDEX%<=LEN(BUF$))THEN II%=ASC(MID$(BUF$,INDEX%,1)) ELSE II%=7
  1812.             endl unless II%=32 AND TEXT%<>0
  1813.         endw
  1814.     wend
  1815.     TEXT$=MID$(BUF$,FIRST%,INDEX%-FIRST%)|
  1816.     IF(LEN(BUF$)>INDEX%)THEN COND$=RIGHT$(BUF$,(LEN(BUF$)-INDEX%)+I.%):C.LN.%=LEN(COND$)
  1817. endp
  1818. proc FILENAMES
  1819.     LINE INPUT"INPUT FILE [.P]:",I.FILE$
  1820.     unless I.FILE$=""
  1821.         COMPIL%=(INSTR(I.FILE$,"/")>0)
  1822.         IF(COMPIL%)THEN I.FILE$=LEFT$(I.FILE$,LEN(I.FILE$)-1)
  1823.         IF(INSTR(I.FILE$,DOT$)=0)THEN I.FILE$=I.FILE$+IEXT$
  1824.         LK.$=I.FILE$:LK.%=I.FILE%:GoSub _Lookup:I.FILE%=LK.%|
  1825.         GOOD%=(I.FILE%<>FALSE%)
  1826.         unless GOOD%=FALSE%
  1827.             I%=INSTR(1,I.FILE$,DOT$)
  1828.             IF(I%=0)THEN I%=LEN(I.FILE$)+1è            E.FILE$=LEFT$(I.FILE$,I%-1)|
  1829.             LINE INPUT"OUTPUT FILE [.BAS]:",O.FILE$
  1830.             IF(O.FILE$="")THEN O.FILE$=E.FILE$
  1831.             IF(INSTR(O.FILE$,DOT$)=0)THEN O.FILE$=O.FILE$+OEXT$
  1832.             E.FILE$=E.FILE$+EEXT$
  1833.         endu
  1834.     endu
  1835. endp
  1836. proc INCLUDES
  1837.     GoSub FILES
  1838.     when FILE.%>0
  1839.         Open"I",FILE.%,FILE$|
  1840.         FILE%=FILE.%
  1841.     else
  1842.         EBUF$="include "+FILE$:GoSub ERRORS
  1843.     endw
  1844. endp
  1845. proc SUBROUTINE
  1846.     GoSub FILES
  1847.     when FILE.%>0
  1848.         TEXT%=0
  1849.         while(TEXT%<INCS%)
  1850.             TEXT%=TEXT%+1|
  1851.             IF(FILE$=INC$(TEXT%))THEN TEXT%=INCS%+1
  1852.         wend
  1853.         IF(TEXT%=INCS%)THEN INCS%=INCS%+1:INC$(INCS%)=FILE$
  1854.     else
  1855.         EBUF$="include "+FILE$:GoSub ERRORS
  1856.     endw
  1857. endp
  1858. proc FILES
  1859.     FILE$=RIGHT$(TEXT$,LEN(TEXT$)-1)|
  1860.     IF(INSTR(FILE$,DOT$)=0)THEN FILE$=FILE$+INCL$
  1861.     FILE.%=FILE%+1|
  1862.     LK.$=FILE$:LK.%=FILE.%:GoSub _Lookup:FILE.%=LK.%
  1863. endp
  1864. proc ERRORS
  1865.     ERRORS%=ERRORS%+1|
  1866.     EBUF$="ERR#"+STR$(ERRORS%)+" MISSING ("+EBUF$+") PROC <"+LPROC$+">"|
  1867.     EBUF$=EBUF$+" AT"+STR$(KERR%)|
  1868.     PRINT EBUF$:PRINT #E.FILE%,EBUF$
  1869. endp
  1870. proc _Fold
  1871.     f.0%=1
  1872.     while(f.0%<=LEN(C.$))
  1873.         f.2%=ASC(MID$(C.$,f.0%,1))
  1874.         f.2%=f.2%+(32*ABS(f.2%>64 AND f.2%<91))
  1875.         MID$(C.$,f.0%,1)=CHR$(f.2%):f.0%=f.0%+1
  1876.     wend
  1877. endp
  1878. proc _Lookup
  1879.     OPEN"R",LK.%,LK.$:L.K!=LOF(LK.%):CLOSE LK.%
  1880.     IF(L.K!<1)THEN LK.%=0:KILL LK.$
  1881. endp
  1882. è
  1883. XFRAME.M
  1884.  
  1885. '┌────────────────────────────────────────────────────┐
  1886. '│    UTL: IBM & MSDOS ONLY                           │ 
  1887. '└────────────────────────────────────────────────────┘
  1888. '- Program:XFRAME 
  1889. '- System :PPE TOOLS
  1890. '- Module :UTL
  1891. '- Task   :INSERT FRAMES IN TEXT FILES
  1892. '-        :EXAMPLE SOURCE TO BE PREPROCESSED BY BMLP & BSLP
  1893. '- Created:10.1.84
  1894. '- By     :D. L. Bendorf
  1895. '- Version:N/A
  1896. '- Notes  :This is a simple little program utility to insert pretty 
  1897. '-        :block graphic frames (like those above and below) in text files. 
  1898. '-        :Four types of frames are provided.
  1899. '-        :To insert a frame, you will have to mark the location.
  1900. '-        :This is done by using a `^' carrot for the upper left and right
  1901. '-        :corners and then bottom left corner.
  1902. '-        :Insert a number (0..3) on the right side of the upper left corner
  1903. '-        :to select the type of frame you want; the default is zero.
  1904. '-        :Examples:
  1905. '-        :   1.     ^0    ^            ╔═════╗     
  1906. '-        :                   will make ║     ║ 
  1907. '-        :          ^                  ╚═════╝ 
  1908. '-        :
  1909. '-        :   2.     ^1    ^            ┌─────┐     
  1910. '-        :                   will make │     │ 
  1911. '-        :          ^                  └─────┘ 
  1912. '-        :
  1913. '-        :   3.     ^2    ^            ╓─────╖     
  1914. '-        :                   will make ║     ║ 
  1915. '-        :          ^                  ╙─────╜ 
  1916. '-        :
  1917. '-        :   4.     ^3    ^            ╒═════╕     
  1918. '-        :                   will make │     │ 
  1919. '-        :          ^                  ╘═════╛ 
  1920. '-        :If you need to change then corner-stone (^) to something else,
  1921. '-        :use:  ^=some-other-mark ,example: ^=@
  1922. '-        :Tabs are set to expand to four spaces, to set to some other value,
  1923. '-        :use:  ^Tsome-value , example: ^T8 sets tabs to expand eight spaces. 
  1924. '-         
  1925. '- History:
  1926. '┌────────────────────────────────────────────────────┐
  1927. '│ ** Data Division                                   │
  1928. '└────────────────────────────────────────────────────┘
  1929.  
  1930. LIBRARY XFRAME
  1931.  
  1932. NULL$  = ""
  1933. DOT$   = "."
  1934. BLANK$ = "   "
  1935. I.FILE%=1
  1936. O.FILE%=2èI.FILE$=""
  1937. O.FILE$=""
  1938. XLINE.$=" "
  1939. FALSE% =0
  1940. GOOD%  =0
  1941. MK$    =CHR$(94)
  1942. TB%    =4
  1943. EQUATE$="="
  1944. TABS$  ="T"
  1945. IEXT$  =".DOC"
  1946. OEXT$  =".F"
  1947. macro INSERT
  1948.     BK%=[1]:CK%=[2]:GoSub INSERT-BLOCK
  1949. endm
  1950. macro FSPEC
  1951.     I%=INSTR(1,[1],DOT$):IF(I%=0)THEN [1]=[1]+[2]
  1952. endm
  1953. DIM TLC%(3),TRC%(3),HL%(3),BLC%(3),BRC%(3),VL%(3)
  1954. DIM EL%(20)
  1955. DIM BL%(20)
  1956. DIM MK%(132,20)
  1957. READ TLC%(0),TLC%(1),TLC%(2),TLC%(3)
  1958. READ TRC%(0),TRC%(1),TRC%(2),TRC%(3)
  1959. READ HL%(0),HL%(1),HL%(2),HL%(3)
  1960. READ BLC%(0),BLC%(1),BLC%(2),BLC%(3)
  1961. READ BRC%(0),BRC%(1),BRC%(2),BRC%(3)
  1962. READ VL%(0),VL%(1),VL%(2),VL%(3)
  1963. DATA 201,218,214,213
  1964. DATA 187,191,183,184
  1965. DATA 205,196,196,205
  1966. DATA 200,192,211,212
  1967. DATA 188,217,189,190
  1968. DATA 186,179,186,179
  1969. for I%=0 to 20
  1970.  for Q%=0 to 132
  1971.   MK%(Q%,I%)=-1
  1972.  next Q%
  1973. next I%
  1974. '┌────────────────────────────────────────────────────┐
  1975. '│ ** Procedure Division                              │
  1976. '└────────────────────────────────────────────────────┘
  1977. prog XFRAME
  1978.     GoSub FILENAMES
  1979.  
  1980.     when GOOD%
  1981.         GoSub PROCESS-FILE
  1982.  
  1983.         PRINT"Done!"
  1984.  
  1985.     else unless I.FILE$=NULL$
  1986.  
  1987.         PRINT"Can not open ";I.FILE$
  1988.  
  1989.     endw
  1990. pendèproc FILENAMES
  1991.     line input"INPUT FILE:",I.FILE$
  1992.  
  1993.     unless I.FILE$=NULL$
  1994.  
  1995.         $fspec I.FILE$,IEXT$
  1996.         $lookup I.FILE$,I.FILE%
  1997.         GOOD%=(I.FILE% <> FALSE%)
  1998.  
  1999.         unless GOOD%=FALSE%
  2000.  
  2001.             line input"OUTPUT FILE:",O.FILE$
  2002.  
  2003.             unless O.FILE$<>NULL$
  2004.                 I%=INSTR(1,I.FILE$,DOT$)
  2005.                 IF(I%=0)THEN I%=LEN(I.FILE$)+1
  2006.                 O.FILE$=LEFT$(I.FILE$,I%-1)
  2007.             endu
  2008.  
  2009.             $fspec O.FILE$,OEXT$
  2010.             OPEN"O",O.FILE%,O.FILE$
  2011.             OPEN"I",I.FILE%,I.FILE$
  2012.             PRINT"Writing..";O.FILE$
  2013.  
  2014.         endu
  2015.  
  2016.     endu
  2017. endp
  2018. proc PROCESS-FILE
  2019.     loop
  2020.         $linput I.FILE%,XLINE.$
  2021.         when INSTR(1,XLINE.$,MK$)>0
  2022.             GoSub PROCESS-XLINE
  2023.         else when BQ%>0
  2024.             GoSub INSERT-SIDES
  2025.         endw
  2026.         unless XLINE.$=BLANK$
  2027.             PRINT #O.FILE%,XLINE.$
  2028.         endu
  2029.     until EOF(I.FILE%)
  2030.     CLOSE
  2031. endp
  2032. proc PROCESS-XLINE
  2033.     GoSub REMOVE-TABS
  2034.     DQ%=BQ%
  2035.     I%=0
  2036.     while INSTR(I%+1,XLINE.$,MK$)>0
  2037.         GoSub SCAN-XLINE
  2038.         when IZ%=0
  2039.             IF(DQ%>0)THEN GoSub INSERT-SIDES
  2040.             GoSub TOP-FRAME
  2041.         else
  2042.             GoSub BOTTOM-FRAME    
  2043.         endw
  2044.     wendè    IF(BQ%>0)THEN GoSub INSERT-SIDES
  2045. endp
  2046. proc SCAN-XLINE
  2047.     I%=INSTR(I%+1,XLINE.$,MK$):IK%=0:IZ%=0
  2048.     while IK%<DQ% and IZ%=0
  2049.         IF(MK%(I%,IK%)>-1)THEN IZ%=1 ELSE IK%=IK%+1
  2050.     wend
  2051. endp
  2052. proc TOP-FRAME
  2053.     BL%(BQ%)=I%
  2054.     EL%(BQ%)=INSTR(I%+1,XLINE.$,MK$)
  2055.     when EL%(BQ%)>0
  2056.         FT%=VAL(MID$(XLINE.$,I%+1,1))
  2057.         MID$(XLINE.$,I%+1,1)=" "
  2058.         IF(EL%(BQ%)>EK%)THEN EK%=EL%(BQ%)
  2059.         MK%(BL%(BQ%),BQ%)=FT%
  2060.         Q%=BQ%:GoSub TOP-LINE 
  2061.         BQ%=BQ%+1:DQ%=BQ%
  2062.     else when MID$(XLINE.$,I%+1,1)=EQUATE$
  2063.         MK$=MID$(XLINE.$,I%+2,1):XLINE.$=BLANK$
  2064.     else when MID$(XLINE.$,I%+1,1)=TABS$
  2065.         TB%=val(MID$(XLINE.$,I%+2,1)):XLINE.$=BLANK$
  2066.     endw
  2067. endp
  2068. proc BOTTOM-FRAME
  2069.     Q%=IK%:FT%=MK%(I%,IK%)
  2070.     GoSub BOTTOM-LINE
  2071.     MK%(I%,IK%)=-1:BQ%=BQ%-1
  2072. endp
  2073. proc TOP-LINE
  2074.     GoSub LINE-LENGTH
  2075.     B%=BL%(Q%):E%=EL%(Q%)
  2076.     $insert B%,TLC%(FT%)
  2077.     GoSub TOPS-BOTTOMS
  2078.     $insert E%,TRC%(FT%)
  2079. endp
  2080. proc BOTTOM-LINE
  2081.     GoSub LINE-LENGTH
  2082.     B%=BL%(Q%):E%=EL%(Q%)
  2083.     $insert B%,BLC%(FT%)
  2084.     GoSub TOPS-BOTTOMS
  2085.     $insert E%,BRC%(FT%)
  2086. endp
  2087. proc TOPS-BOTTOMS
  2088.     B%=B%+1
  2089.     while B%<E%
  2090.         $insert B%,HL%(FT%)
  2091.         B%=B%+1
  2092.     wend
  2093. endp
  2094. proc INSERT-SIDES
  2095.     IF(INSTR(XLINE.$,CHR$(9)))THEN GoSub REMOVE-TABS
  2096.     GoSub LINE-LENGTH
  2097.     J%=0
  2098.     while J%<BQ%è        FT%=MK%(BL%(J%),J%)
  2099.         when FT%>-1
  2100.             $insert BL%(J%),VL%(FT%)
  2101.             $insert EL%(J%),VL%(FT%)
  2102.         endw
  2103.         J%=J%+1
  2104.     wend
  2105. endp
  2106. proc LINE-LENGTH
  2107.     unless LEN(XLINE.$)=>EK%
  2108.         XLINE.$=XLINE.$+STRING$(EK%-LEN(XLINE.$)+1,32)
  2109.     endu
  2110. endp
  2111. proc REMOVE-TABS
  2112.     T%=INSTR(1,XLINE.$,CHR$(9))
  2113.     while T%>0
  2114.         L$=LEFT$(XLINE.$,T%-1)
  2115.         R$=RIGHT$(XLINE.$,LEN(XLINE.$)-T%)
  2116.         XLINE.$=L$+STRING$(TB%,32)+R$
  2117.         T%=INSTR(1,XLINE.$,CHR$(9))
  2118.     wend
  2119. endp
  2120. proc INSERT-BLOCK
  2121.     unless BK%=0
  2122.         when MID$(XLINE.$,BK%,1)=" " or MID$(XLINE.$,BK%,1)=MK$
  2123.             MID$(XLINE.$,BK%,1)=CHR$(CK%)
  2124.         endw
  2125.     endu
  2126. endp
  2127. '┌────────────────────────────────────────────────────┐
  2128. '│ ** Sub-Routine Division                            │
  2129. '└────────────────────────────────────────────────────┘
  2130.  
  2131.  
  2132. XFRAME.ML
  2133.  
  2134. ;;==========================================================================
  2135. ; NOTE:
  2136. ;         THE `|' VERTICAL BAR IS USED AS A CONTINUATION MARK.
  2137. ; DOCUMENTATION ABREVIATIONS:
  2138. ;         S/L  =  STRING VARIABLE OR LITERAL ENCLOSED WITH DOUBLE QUOTES.
  2139. ;         N/L  =  NUMERIC VARIABLE OR LITERAL.
  2140. ;         S    =  STRING VARIABLE ONLY.
  2141. ;         N    =  NUMERIC VARIABLE ONLY.         
  2142. ;         S/N  =  STRING OR NUMERIC VARIABLE.
  2143. ;         
  2144. ;;==========================================================================
  2145. ;**
  2146. ::LOOKUP (Macro)
  2147. ;**   FUNCTION:
  2148. ;**             Verify the existence of a file.
  2149. ;**   USAGE:
  2150. ;**             Two parameters required.
  2151. ;**     Calling:
  2152. ;**             [1] - S/L - a valid file name.è;**             [2] - N   - a valid file number (>0).
  2153. ;**     Returning:
  2154. ;**             [2] - zero if file not found.
  2155. ;**   EXAMPLE:
  2156. ;**             TXT% = 2
  2157. ;**             $lookup "myfile.txt",TXT%
  2158. ;**                       (if "myfile.txt" is not found then TXT% = 0.)
  2159. ;**             $lookup MYFILE$,TXT%
  2160. ;**
  2161. MACRO LOOKUP
  2162.    XX.$=[1]:XX.%=[2]:Gosub _Lookup:[2]=XX.%
  2163.    $$_LOOKUP
  2164. ENDM
  2165. ;;==========================================================================
  2166. ;**
  2167. ::_LOOKUP (Subroutine)
  2168. ;**   FUNCTION:
  2169. ;**             Subroutine called by LOOKUP macro.
  2170. ;**
  2171. MACRO _LOOKUP
  2172. Proc _Lookup
  2173.    Open"R",XX.%,XX.$:X.X!=LOF(XX.%):Close XX.%|
  2174.    IF(X.X!<1)Then XX.%=0:Kill XX.$
  2175. Endp
  2176. ENDM
  2177. ;;==========================================================================
  2178. ;**
  2179. ::OPENFI (Macro)
  2180. ;**   FUNCTION:
  2181. ;**             Open a file for input.
  2182. ;**   USAGE:
  2183. ;**             Two parameters required.
  2184. ;**     Calling:
  2185. ;**             [1] - S/L - valid file name.
  2186. ;**             [2] - N/L - valid file number.
  2187. ;**   EXAMPLE:
  2188. ;**             $openfi "myfile.txt",2
  2189. ;**             $openfi MYFILE$,MYFILE%
  2190. ;**             
  2191. MACRO OPENFI
  2192.    Open"I",[2],[1]
  2193. ENDM
  2194. ;;==========================================================================
  2195. ;**
  2196. ::OPENFO (Macro)
  2197. ;**   FUNCTION:
  2198. ;**             Open a file for output.
  2199. ;**   USAGE:
  2200. ;**             Two parameters required.
  2201. ;**     Calling:
  2202. ;**             [1] - S/L - valid file name.
  2203. ;**             [2] - N/L - valid file number.
  2204. ;**   EXAMPLE:
  2205. ;**             $openfo "myfile.txt",2
  2206. ;**             $openfo MYFILE$,MYFILE%è;**             
  2207. MACRO OPENFO
  2208.    Open"O",[2],[1]
  2209. ENDM
  2210. ;;==========================================================================
  2211. ;**
  2212. ::LINPUT (Macro)
  2213. ;**   FUNCTION:
  2214. ;**             Input a line from a file open for input.
  2215. ;**   USAGE:
  2216. ;**             Two parameters required.
  2217. ;**     Calling:
  2218. ;**             [1] - N/L - valid file number.
  2219. ;**     Returning:
  2220. ;**             [2] - S   - string buffer.
  2221. ;**   EXAMPLE:
  2222. ;**             $linput 2,BUFFER$
  2223. ;**             $linput BUF%,BUFFER$
  2224. ;**             
  2225. MACRO LINPUT
  2226.    Line Input #[1],[2]
  2227. ENDM
  2228. ;;==========================================================================